Initial revision

diff --git a/etc/OXYMORONS b/etc/OXYMORONS
new file mode 100644 (file)
index 0000000..3528654
--- /dev/null
+++ b/etc/OXYMORONS
@@ -0,0 +1,42 @@
+The theme of the gamma series of 21.4 releases is "oxymoron", that is,
+contradiction in terms.  Each patchlevel will be assigned a unique
+codename from the list below.  The rationale for the first should be
+obvious.
+
+The second and third are my tributes to Richard Stallman and the early
+developers of Lucid Emacs/XEmacs (primarily Jamie Zawinski, but it
+also fits Ben Wing which is appropriate to the Mule theme), in
+chronological order.  I cannot list all the debts this release owes
+for individual contributions, but I must credit the fundamental
+excellence of the design of [X]Emacs for inspiring the audacious
+proposal to add both GTK and Windows/MULE to XEmacs over a period of
+two months, and for the success of the GTK merge.  Without the
+prospect of such a big win, I could not have justified trying to
+coordinate a release myself.
+
+The rest of the codenames are in alphabetical order.
+
+N.B. I expect that the Stable Release Maintainer will choose a new
+theme for the releases following the promotion of 21.4 from "gamma" to
+"stable".  So 15 should be enough....
+
+21.4.0: Solid Vapor
+21.4.1: Copyleft
+21.4.2: Developer-Friendly Unix APIs
+21.4.3: Academic Rigor
+21.4.3: Artificial Intelligence
+21.4.3: Civil Service
+21.4.3: Common Lisp
+21.4.3: Economic Science
+21.4.3: Honest Politician
+21.4.3: Informed Management
+21.4.3: Military Intelligence
+21.4.3: Portable Code
+21.4.3: Rational FORTRAN
+21.4.3: Reasonable Discussion
+21.4.3: Standard C
+
+N.B.  Suggestions welcome until shortly before the release.  (The
+non-incrementing version number is precisely to make it easy to add
+new oxymorons.)
+

diff --git a/etc/sample.init.el b/etc/sample.init.el
new file mode 100644 (file)
index 0000000..ef6ec7f
--- /dev/null
+++ b/etc/sample.init.el
@@ -0,0 +1,1384 @@
+;; -*- Mode: Emacs-Lisp -*-
+
+;; Copyright (C) 2000, 2001 Ben Wing.
+
+;; Author: Mostly Ben Wing <ben@xemacs.org>
+;; Maintainer: XEmacs Development Team
+;; Keywords: sample, initialization
+
+;; 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;; #### to do:
+;; -- #### figure out how init.el and custom.el interact and put
+;;         documentation about it here. (perhaps it already exists
+;;         elsewhere?)
+
+;;; This is a sample init.el file.  It can be used without
+;;; modification as your init.el or .emacs.  In older versions of
+;;; XEmacs, this file was called .emacs and placed in your home
+;;; directory. (Under MS Windows, that directory is controlled by the
+;;; HOME environment variable and defaults to C:\.  You can find out
+;;; where XEmacs thinks your home directory is using
+;;;
+;;;   ESC : (expand-file-name "~")
+;;;
+;;; .  This means type ESC, then colon, then the following text, then hit
+;;; return.) In more recent versions of XEmacs, this file has migrated to
+;;; the .xemacs/ subdirectory and is called init.el.  Other files are
+;;; also located here, such as custom.el (the auto-generated file
+;;; containing Customization options that you saved when using
+;;; Options->Save Options).
+
+;;; Changes to your init.el file will not take effect until the next
+;;; time you start up XEmacs, unless you load it explicitly with
+;;;
+;;;   M-x load-file RET ~/.xemacs/init.el RET
+
+;;; The language that this file (and most other XEmacs init files) is
+;;; written in is called "XEmacs Lisp" or more commonly "Elisp".
+
+;;; There are many sources of further information:
+
+;;; -- the XEmacs User's Manual (Access using the online Info browser:
+;;;       Use `Help->Info (Online Docs)->XEmacs User's Manual' (if
+;;;       there is such an entry); or get to the Info contents page
+;;;       using `Help->Info Contents' or `C-h i', and then
+;;;       *middle-click* the XEmacs link or move the cursor into the
+;;;       link and hit ENTER.  This manual contains a great deal of
+;;;       documentation on customization: Scroll down to the
+;;;       Customization link and select it in the same fashion as for
+;;;       the XEmacs link just mentioned.)
+
+;;; -- the XEmacs FAQ (`C-h F' for the local version; get either the
+;;;       local version or the very latest version off the net using
+;;;       the Help menu)
+
+;;; -- the XEmacs Lisp Reference Manual, containing detailed
+;;;       documentation on Elisp. (Access using Info, just like for the
+;;;       XEmacs User's Manual.)
+
+;;; -- the documentation strings for specific commands, functions,
+;;;       key sequences, and variables.  NOTE: This is *not* the same
+;;;       information as in the XEmacs User's Manual or XEmacs Lisp
+;;;       Reference Manual!  In general, the doc strings are more
+;;;       terse and more up-to-date than what is found in the manuals.
+;;;       Once you understand the general concepts, these doc strings
+;;;       should be your first point of reference for further
+;;;       info. (Access using menu entries under `Help->Commands,
+;;;       Variables, Keys' or using the keyboard: `C-h k' for a key
+;;;       sequence, `C-h f' for a named command or Elisp function,
+;;;       `C-h v' for a variable.  There is various other useful
+;;;       information accessible similarly, such as `C-h a'
+;;;       ["Apropos", i.e. search for a command, function, or variable
+;;;       by name]; `C-h C-a' ["Apropos Docs", i.e. search through the
+;;;       text of the doc strings]; `C-h b' to list all key bindings;
+;;;       `C-h m' to describe the current major and minor modes; etc.
+;;;       Type `C-h ? ?' for a complete list.)
+
+;;; -- Getting Started with XEmacs [aka the "New User's Guide"], a
+;;;       more introductory manual than the XEmacs User's Manual.
+;;;       (Access using Info, just like for the XEmacs User's Manual.
+;;;       There are some sections on customization here.)
+
+;;; -- the XEmacs tutorial, a very simple introduction to XEmacs for
+;;;       total beginners. (`C-h t' for English; get the version in
+;;;       various languages from the Help menu)
+
+;;; -- the XEmacs web site, www.xemacs.org.
+
+;;; -- the XEmacs mailing lists (xemacs-FOO@xemacs.org;
+;;;       see http://www.xemacs.org/Lists/ for more info.  Before
+;;;       posting, consider looking through the archives -- they go back
+;;;       years and there is a powerful searching interface.  Currently
+;;;       the archives are at http://list-archive.xemacs.org/, but if
+;;;       this doesn't work, you can always access them through
+;;;       www.xemacs.org.)
+
+;;; -- the XEmacs newsgroup, comp.emacs.xemacs.  This is
+;;;       bi-directionally gatewayed with xemacs@xemacs.org.  WARNING:
+;;;       The developers do not normally hang out on this newsgroup.  If
+;;;       you need to contact them, use xemacs-beta@xemacs.org.
+
+;;; -- the XEmacs internals manual, for those interested in working on
+;;;       the XEmacs C code. (Available through Info.)
+
+;;; -- `Help->About XEmacs' to find out who the maintainers are.
+
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;                      Basic Customization                         ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; TIP: Control-L characters are ignored in Lisp files and are the
+;; standard way of indicating major section divisions.  You can enter
+;; such a character using C-q C-l.
+
+;; Define a variable to indicate whether we're running XEmacs/Lucid
+;; Emacs.  (You do not have to defvar a global variable before using
+;; it -- you can just call `setq' directly.  It's clearer this way,
+;; though.  Note also how we check if this variable already exists
+;; using `boundp', because it's defined in recent versions of
+;; XEmacs.)
+
+(or (boundp 'running-xemacs)
+    (defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version)))
+
+;; Define a function to make it easier to check which version we're
+;; running.  This function already exists in recent XEmacs versions,
+;; and in fact all we've done is copied the definition.  Note again
+;; how we check to avoid clobbering an existing definition. (It's good
+;; style to do this, in case some improvement was made to the
+;; already-existing function -- otherwise we might subsitute an older
+;; definition and possibly break some code elsewhere.)
+;;
+;; NOTE ALSO: It is in general *NOT* a good idea to do what we're
+;; doing -- i.e. provide a definition of a function that is present in
+;; newer versions of XEmacs but not older ones.  The reason is that it
+;; may confuse code that notices the presence of the function and
+;; proceeds to use it and other functionality that goes along with it
+;; -- but which we may not have defined.  What's better is to create
+;; the function with a different name -- typically, prefix it with the
+;; name of your module, which in this case might be `Init-'.  For
+;; `emacs-version>=' we make an exception because (a) the function has
+;; been around a long time, (b) there isn't really any other
+;; functionality that is paired with it, (c) it's definition hasn't
+;; changed and isn't likely to, and (d) the calls to `emacs-version>='
+;; or its renamed replacement would be scattered throughout the code
+;; below, and with a replacement name the code would become
+;; significantly less portable into someone else's init.el file. (BUT
+;; NOTE BELOW: We do follow the procedure outlined above with renaming
+;; in a different case where the specifics are much different.)
+;;
+;; TIP: At this point you may be wondering how I wrote all these nice,
+;; long, nicely-justified textual stretches -- didn't I go crazy
+;; sticking in the semicolons everywhere and having to delete them and
+;; rearrange everything whenever I wanted to make any corrections to
+;; the text?  The answer is -- of course not!  Use M-q.  This does all
+;; the magic for you, justifying and breaking lines appropriately and
+;; putting any necessary semicolons or whatever at the left (it
+;; figures out what this ought to be by looking in a very clever
+;; fashion at what's already at the beginning of each line in the
+;; paragraph).  You may need `filladapt' set up (it's done below in
+;; this file) in order for this to work properly.  Finally, if you
+;; want to turn on automatic filling (like in a word processor, but
+;; not quite as automatic), use M-x auto-fill-mode or the binding set
+;; up below in this file (Meta-F9).
+
+(or (fboundp 'emacs-version>=)
+    (defun emacs-version>= (major &optional minor patch)
+      "Return true if the Emacs version is >= to the given MAJOR, MINOR,
+   and PATCH numbers.
+The MAJOR version number argument is required, but the other arguments
+argument are optional. Only the Non-nil arguments are used in the test."
+      (let ((emacs-patch (or emacs-patch-level emacs-beta-version -1)))
+       (cond ((> emacs-major-version major))
+             ((< emacs-major-version major) nil)
+             ((null minor))
+             ((> emacs-minor-version minor))
+             ((< emacs-minor-version minor) nil)
+             ((null patch))
+             ((>= emacs-patch patch))))))
+
+;; 19.13 was released ages ago (Sep. 1995), and lots of graphic and
+;; window-system stuff doesn't work before then.
+
+(or (not running-xemacs)
+    (emacs-version>= 19 13)
+    (error "This init file does not support XEmacs before 19.13"))
+
+;; Here are some example code snippets that you can use if you need to
+;; conditionalize on a particular version of Emacs (in general, though,
+;; it is much better to use `fboundp', `featurep', or other such
+;; feature-specific checks rather than version-specific checks):
+
+; (cond ((and running-xemacs
+;          (emacs-version>= 21 2))
+;        ;;
+;        ;; Code requiring XEmacs version 21.2 or newer goes here
+;        ;;
+;        ))
+
+; (cond ((emacs-version >= 19 0)
+;        ;;
+;        ;; Code for any vintage-19 Emacs goes here
+;        ;;
+;        ))
+
+; (cond ((and (not running-xemacs)
+;          (emacs-version>= 20 0))
+;        ;;
+;        ;; Code specific to GNU Emacs 20 or newer (not XEmacs) goes here
+;        ;;
+;        ))
+
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;                          Key Definitions                         ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; Set up the function keys to do common tasks to reduce Emacs pinky
+;;; and such.
+
+;; You can set a key sequence either to a command or to another key
+;; sequence. (Use `C-h k' to map a key sequence to its command.  Use
+;; `C-h w' to go the other way.) In general, however, it works better
+;; to specify the command name.  For example, it does not currently
+;; work to say
+
+;;   (global-set-key 'f5 "\C-x\C-f")
+
+;; The reason is that macros (which is what the string on the right
+;; really is) can't currently use the minibuffer.  This is an
+;; extremely longstanding bug in Emacs.  Eventually, it will be
+;; fixed. (Hopefully ..)
+
+;; Note also that you may sometimes see the idiom
+
+;;   (define-key global-map ...)
+
+;; in place of (global-set-key ...).  These are exactly the same.
+
+;; Here I've tried to put all the most common commands on simple
+;; non-modifier function keys to take the pressure off your modifier
+;; fingers.  Furthermore, on my keyboard at least, the function keys
+;; are grouped into three groups of four with spaces between them, and
+;; so it's easier to hit the keys at the edge of the groups --
+;; i.e. f1, f4, f5, f8, f9, and f12.  Finally, you may note that f9,
+;; f11, and f12 are purposely left blank. [F6 is defined below.]
+;; That's because I use them for _, {, and } -- see below.
+
+(global-set-key 'f1 'advertised-undo) ;; Undo
+(global-set-key 'f2 'kill-primary-selection) ;; Cut
+(global-set-key 'f3 'copy-primary-selection) ;; Copy
+(global-set-key 'f4 'yank-clipboard-selection) ;; Paste
+(global-set-key 'f5 'find-file) ;; C-x C-f
+(global-set-key 'f7 'save-buffer) ;; C-x C-s
+
+;; I considered having this retain the current column after killing
+;; the line, but that messes up the common idiom `f8 move-cursor f4'.
+
+(defun Init-kill-entire-line (&optional arg)
+  (interactive "*P")
+  (let ((kill-whole-line t))
+    (beginning-of-line)
+    (call-interactively 'kill-line)))
+
+(global-set-key 'f8
+  (if (fboundp 'kill-entire-line) 'kill-entire-line 'Init-kill-entire-line))
+
+;; A keystroke repeated incredible amounts of times.  We need to patch
+;; into the isearch keymap so that repeat searches while in isearch
+;; mode still work.  Here we show how to make a key in a keymap have the
+;; same binding as another key in the keymap, without knowing what the
+;; binding is in advance; instead, we find it with `lookup-key'.  This
+;; way, if the binding of C-s changes (e.g. to a different function) but
+;; the meaning is basically the same, we automatically do the right thing.
+;; If we put in the actual binding, which is 'isearch-repeat-forward,
+;; this automatic tracking wouldn't happen.
+;;
+;; TIP: To find out what the (lookup-key ...) expression evaluates to,
+;; move just to the right of the closing paren and type C-x C-e.
+
+(global-set-key 'f10 'isearch-forward)
+(define-key isearch-mode-map 'f10 (lookup-key isearch-mode-map "\C-s"))
+(define-key minibuffer-local-isearch-map 'f10
+  (lookup-key minibuffer-local-isearch-map "\C-s"))
+(global-set-key '(shift f10) 'isearch-backward)
+(define-key isearch-mode-map '(shift f10) (lookup-key isearch-mode-map "\C-r"))
+(define-key minibuffer-local-isearch-map '(shift f10)
+  (lookup-key minibuffer-local-isearch-map "\C-r"))
+
+;; Here we define our own function and then bind a key to it.
+
+(defun start-or-end-kbd-macro ()
+  ;; A doc string.  This is optional.
+  "Start defining a keyboard macro, or stop if we're already defining."
+  ;; IMPORTANT: Any function bound to a key MUST have an interactive spec,
+  ;; usually just the following line:
+  (interactive)
+  (if defining-kbd-macro
+      (end-kbd-macro)
+    (start-kbd-macro nil)))
+
+;; The macros used to have their place in the function keys, but I
+;; find that I use them significantly less than the really basic
+;; things on the function keys.  When using a macro, you call the
+;; macro much more than define it, so the setup below makes some
+;; sense.
+
+(global-set-key '(shift kp-multiply) 'start-or-end-kbd-macro)
+(global-set-key 'kp-multiply 'call-last-kbd-macro) ;; C-x e
+
+;; Note that you can refer to a key sequence either using an ASCII
+;; string or the "long way", with vectors and conses.  You saw above
+;; (in a comment) the string form for specifying the key sequence `C-x
+;; C-f', which is "\C-x\C-f". (For those curious, \C-x is just an
+;; escape sequence that puts a ^X character into the string.  Thus,
+;; the string just mentioned really just contains two characters, a ^X
+;; and a ^F.) The long way to specify the sequence `C-x C-f' would be
+;;
+;; [(control x) (control f)]
+;;
+;; The long format lets you specify all possible key sequences, while the
+;; string form only lets you specify sequences involving ASCII characters
+;; and/or modifiers and in fact only a subset of them.
+;;
+;; Other examples are:
+;;
+;; [(control x) n]
+;;
+;;   (You can leave out the parens when there is no modifier specified in
+;;    the keystroke, and that's normally done.)
+;;
+;; [(shift control meta left)]
+;;
+;;   (You can put more than one modifier in a keystroke.)
+;;
+;; (shift control meta left)
+;;
+;;   (This is the same as the previous.  when there's only one keystroke in
+;;    the sequence, you can leave out the brackets, and that's normally
+;;    done.)
+;;
+;; [(control x) (shift button3)]
+;;
+;;   (You can refer to mouse buttons just like keys -- apply modifiers,
+;;    intermingle them in key sequences, etc.  But there's only problem
+;;    here, which is that with the mouse you don't just have one possible
+;;    gesture, like with keys.  You'd really like to control button-down,
+;;    button-up, button-click (down and up without selecting anything),
+;;    button drag, button double-click, etc.  This is normally done by
+;;    binding your key sequence to `mouse-track', and then putting hooks
+;;    onto `mouse-track-click-hook', `mouse-track-drag-up-hook', etc. to
+;;    customize the specific behavior.)
+;;
+;; 'left
+;;
+;;   (Ultimate reductionism -- no brackets, no parens.  This is the form, in
+;;    that, that the 'f1, 'f2, etc. took, which where in fact "long"
+;;    forms.)
+;; 
+;; '(control C)
+;;
+;;   (You cannot use '(control shift c) here.  This applies whenever Shift +
+;;    key translates to a single character.  Note also that you can't use
+;;    "\C-C" either; this refers to the non-shifted C-c, just like "\C-c"
+;;    would.)
+;;
+;; '(control \()
+;;   (Put a backslash in front of characters used in Lisp syntax.)
+;;
+;; Also, you can find out the name of a key using C-h c.  WARNING:
+;; This does not report the correct name of the keys named `delete',
+;; `backspace', `return', `tab', `space', `escape', and `linefeed'!
+;; (More correct results can be achieved using
+;;
+;; ESC : (read-key-sequence "foo: ")
+;;
+;; .)
+
+;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Keystrokes to conveniently switch buffers.
+
+;; F6 is invaluable for flipping back and forth between two buffers
+;; you're working with.
+
+(global-set-key 'f6 'switch-to-other-buffer) ;; M-C-l
+(global-set-key '(meta n) 'switch-to-next-buffer-in-group)
+(global-set-key '(meta p) 'switch-to-previous-buffer-in-group)
+(global-set-key '(meta N) 'switch-to-next-buffer)
+(global-set-key '(meta P) 'switch-to-previous-buffer)
+
+;; Define our own function to deal with the possibility that the newer
+;; stuff in the gutter code may not be present -- i.e. we're running
+;; an older XEmacs.  Note that we avoid trying to "helpfully" define a
+;; function that is present in new versions of XEmacs, but not in
+;; older ones.  That can very easily screw up code trying to determine
+;; what functionality is present using `fboundp' checks.  See above,
+;; near `emacs-version>=', for a full discussion of this.
+
+(defun Init-buffers-tab-omit (buf)
+  ;; a function specifying the buffers to omit from the buffers tab.
+  ;; This is passed a buffer and should return non-nil if the buffer
+  ;; should be omitted.  If the standard buffers-tab functionality is
+  ;; there, we just call it to do things "right".  Otherwise we just
+  ;; omit invisible buffers, snarfing the code from
+  ;; `buffers-menu-omit-invisible-buffers'.
+  (if (boundp 'buffers-tab-omit-function)
+      (funcall buffers-tab-omit-function buf)
+    (not (null (string-match "\\` " (buffer-name buf))))))
+
+(defun switch-to-next-buffer (&optional n)
+  "Switch to the next-most-recent buffer.
+This essentially rotates the buffer list forward.
+N (interactively, the prefix arg) specifies how many times to rotate
+forward, and defaults to 1.  Buffers whose name begins with a space
+\(i.e. \"invisible\" buffers) are ignored."
+  ;; Here is a different interactive spec.  Look up the function
+  ;; `interactive' (i.e. `C-h f interactive') to understand how this
+  ;; all works.
+  (interactive "p")
+  (dotimes (n (or n 1))
+    (loop
+      do (bury-buffer (car (buffer-list)))
+      while (Init-buffers-tab-omit (car (buffer-list))))
+    (switch-to-buffer (car (buffer-list)))))
+
+(defun buffers-menu-omit-invisible-buffers (buf)
+  "For use as a value of `buffers-menu-omit-function'.
+Omits normally invisible buffers (those whose name begins with a space)."
+  (not (null (string-match "\\` " (buffer-name buf)))))
+
+(defvar Init-buffers-tab-grouping-regexp 
+  '("^\\(gnus-\\|message-mode\\|mime/viewer-mode\\)"
+    "^\\(emacs-lisp-\\|lisp-\\)")
+;; If non-nil, a list of regular expressions for buffer grouping.
+;; Each regular expression is applied to the current major-mode symbol
+;; name and mode-name, if it matches then any other buffers that match
+;; the same regular expression be added to the current group.  This is
+;; a copy of `buffers-tab-grouping-regexp'.
+  )
+
+(defun Init-select-buffers-tab-buffers (buffer-to-select buf1)
+  ;; Specifies the buffers to select from the buffers tab.  This is
+  ;; passed two buffers and should return non-nil if the second buffer
+  ;; should be selected.  If the standard buffers-tab functionality is
+  ;; there, we just call it to do things "right".  Otherwise, we group
+  ;; buffers by major mode and by `Init-buffers-tab-grouping-regexp'.
+  ;; [We've copied `select-buffers-tab-buffers-by-mode' and
+  ;; `buffers-tab-grouping-regexp'.]
+  (if (boundp 'buffers-tab-selection-function)
+      (funcall buffers-tab-selection-function buffer-to-select buf1)
+    (let ((mode1 (symbol-name (symbol-value-in-buffer 'major-mode buf1)))
+         (mode2 (symbol-name (symbol-value-in-buffer 'major-mode 
+                                                     buffer-to-select)))
+         (modenm1 (symbol-value-in-buffer 'mode-name buf1))
+         (modenm2 (symbol-value-in-buffer 'mode-name buffer-to-select)))
+      (cond ((or (eq mode1 mode2)
+                (eq modenm1 modenm2)
+                (and (string-match "^[^-]+-" mode1)
+                     (string-match
+                      (concat "^" (regexp-quote 
+                                   (substring mode1 0 (match-end 0))))
+                      mode2))
+                (and Init-buffers-tab-grouping-regexp
+                     (find-if #'(lambda (x)
+                                  (or
+                                   (and (string-match x mode1)
+                                        (string-match x mode2))
+                                   (and (string-match x modenm1)
+                                        (string-match x modenm2))))
+                              Init-buffers-tab-grouping-regexp)))
+            t)
+           (t nil)))))
+
+(defun switch-to-previous-buffer (&optional n)
+  "Switch to the previously most-recent buffer.
+This essentially rotates the buffer list backward.
+N (interactively, the prefix arg) specifies how many times to rotate
+backward, and defaults to 1.  Buffers whose name begins with a space
+\(i.e. \"invisible\" buffers) are ignored."
+  (interactive "p")
+  (dotimes (n (or n 1))
+    (loop
+      do (switch-to-buffer (car (last (buffer-list))))
+      while (Init-buffers-tab-omit (car (buffer-list))))))
+
+(defun switch-to-next-buffer-in-group (&optional n)
+  "Switch to the next-most-recent buffer in the current group.
+This essentially rotates the buffer list forward.
+N (interactively, the prefix arg) specifies how many times to rotate
+forward, and defaults to 1.  Buffers whose name begins with a space
+\(i.e. \"invisible\" buffers) are ignored."
+  (interactive "p")
+  (dotimes (n (or n 1))
+    (let ((curbuf (car (buffer-list))))
+      (loop
+       do (bury-buffer (car (buffer-list)))
+       while (or (Init-buffers-tab-omit (car (buffer-list)))
+                 (not (Init-select-buffers-tab-buffers
+                       curbuf (car (buffer-list)))))))
+    (switch-to-buffer (car (buffer-list)))))
+
+(defun switch-to-previous-buffer-in-group (&optional n)
+  "Switch to the previously most-recent buffer in the current group.
+This essentially rotates the buffer list backward.
+N (interactively, the prefix arg) specifies how many times to rotate
+backward, and defaults to 1.  Buffers whose name begins with a space
+\(i.e. \"invisible\" buffers) are ignored."
+  (interactive "p")
+  (dotimes (n (or n 1))
+    (let ((curbuf (car (buffer-list))))
+      (loop
+       do (switch-to-buffer (car (last (buffer-list))))
+       while (or (Init-buffers-tab-omit (car (buffer-list)))
+                 (not (Init-select-buffers-tab-buffers
+                       curbuf (car (buffer-list)))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Other text keystrokes.
+
+;; Make a keystroke to insert a literal TAB character. (`C-q TAB' is
+;; annoying because difficult to repeat.) Note that this does not work
+;; in TTY frames, where TAB and Shift-TAB are indistinguishable.
+(define-key global-map '(shift tab) 'tab-to-tab-stop)
+
+;; Toggle auto-filling.  Useful with text but annoying with code.  You
+;; can manually fill with M-q.
+(global-set-key '(meta f9) 'auto-fill-mode)
+
+;; You cannot say '(meta shift t) here -- see above.
+(if (fboundp 'transpose-line-down)
+    (global-set-key '(meta T) 'transpose-line-down))
+(if (fboundp 'transpose-line-up)
+    (global-set-key '(control T) 'transpose-line-up))
+
+;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Rearrange some inconvenient bindings.
+
+;; ESC ESC ESC is a useful command, but too long.  ESC ESC would be
+;; much more logical, but interferes with Meta + keypad/arrow keys on
+;; TTY's.  But most people only use window systems and no such problem
+;; exists there, so set up the more logical binding there.
+;;
+;; Note also the use of if vs. cond/when/unless/or/and to express
+;; conditional statements.  The difference is purely stylistic.
+
+(when (console-on-window-system-p)
+  (global-set-key '(meta escape) 'keyboard-escape-quit)
+  (define-key isearch-mode-map '(meta escape) 'isearch-cancel))
+
+;; The standard definition of C-z causes iconification on window
+;; systems, which is both useless and annoying.  Instead, bind it to a
+;; useful command that's not on any keys. (This also makes a neat
+;; parallelism with M-z, which does zap-to-char.) Don't override the
+;; TTY binding, which does "Suspend".  If you want this new binding on
+;; TTY's, and can train yourself to use C-x C-z to suspend, then
+;; remove or comment out the `when' statement. (Here's the proper way
+;; to comment out such a statement:
+;;
+;; ;(when (console-on-window-system-p)
+;;   (global-set-key "\C-z" 'zap-up-to-char)
+;; ;  )
+;;
+;; To do this, I first moved the closing paren to a new line,
+;; reindented with TAB, then added the semicolons.)
+ 
+(when (console-on-window-system-p)
+  (global-set-key "\C-z" 'zap-up-to-char))
+
+;; When not on a TTY, remove the binding of C-x C-c, which normally
+;; exits XEmacs.  It's easy to hit this by mistake, and that can be
+;; annoying.  You can always quit with the "Exit XEmacs" option on the
+;; File menu.
+
+(when (console-on-window-system-p)
+    (global-set-key "\C-x\C-c" nil))
+
+;; Make C-k always delete the whole line, which is what most people want,
+;; anyway.
+(setq kill-whole-line 'always)
+;; M-k does the old behavior (kill to end of line).
+(global-set-key '(meta k) #'(lambda ()
+                             (interactive)
+                             (if (fboundp 'historical-kill-line)
+                                 (call-interactively #'historical-kill-line)
+                               (let ((kill-whole-line nil))
+                                 (call-interactively #'kill-line)))))
+;; and Meta-Shift-K does what used to be on M-k, and should
+;; (hopefully) even work under TTY's.
+(global-set-key '(meta K) 'kill-sentence)
+
+;; Make sure we get Windows-like shifted-motion key selection behavior
+;; on recent XEmacs versions.
+(if (boundp 'shifted-motion-keys-select-region)
+    (setq shifted-motion-keys-select-region t)
+  ;; otherwise, try the pc-select package -- 
+  (condition-case nil
+      (progn
+       (require 'pc-select)
+       (pc-select-mode 1))
+    (error nil)))
+
+;; The following commented-out code rearranges the keymap in an
+;; unconventional but extremely useful way for programmers.  Parens
+;; and braces are both available without using the shift key (using
+;; the bracket keys and f11/f12, respectively).  Brackets (much less
+;; used) are the shifted versions of the new paren keys (i.e. where
+;; the braces normally are).
+;;
+;; The idea for this comes from Jamie Zawinski.
+;;
+;; Also make a convenient keystroke for _, used constantly in C code.
+;;
+;; NOTE: you can (semi-) conveniently uncomment a region using
+;; C-u M-x comment-region, or the "Uncomment Region" menu item on the
+;; Lisp menu in new enough versions of XEmacs.
+
+;(keyboard-translate ?[ ?()
+;(keyboard-translate ?] ?))
+;(keyboard-translate ?{ ?[)
+;(keyboard-translate ?} ?])
+;;; We don't use `keyboard-translate' for these because it messes up
+;;; bindings for M-F9 and the like.
+;(define-key key-translation-map 'f11 "{")
+;(define-key key-translation-map 'f12 "}")
+;(define-key key-translation-map 'f9 "_")
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Useful programming-related keystrokes.
+
+(defun describe-foo-at-point ()
+  (interactive)
+  (let (sym)
+    ;; sigh, function-at-point is too clever.  we want only the first half.
+    (cond ((setq sym (ignore-errors
+                      (with-syntax-table emacs-lisp-mode-syntax-table
+                        (save-excursion
+                          (or (not (zerop (skip-syntax-backward "_w")))
+                              (eq (char-syntax (char-after (point))) ?w)
+                              (eq (char-syntax (char-after (point))) ?_)
+                              (forward-sexp -1))
+                          (skip-chars-forward "`'")
+                          (let ((obj (read (current-buffer))))
+                            (and (symbolp obj) (fboundp obj) obj))))))
+          (describe-function sym))
+         ((setq sym (variable-at-point)) (describe-variable sym))
+         ;; now let it operate fully -- i.e. also check the
+         ;; surrounding sexp for a function call.
+         ((setq sym (function-at-point)) (describe-function sym)))))
+
+(global-set-key '(shift f4) 'next-error) ;; C-x `
+(global-set-key '(control f4) 'previous-error)
+(global-set-key '(shift f5) 'find-library)
+(global-set-key '(control f5) 'find-function)
+(global-set-key '(meta f5) 'find-variable)
+(global-set-key '(shift f11) 'describe-foo-at-point)
+(global-set-key '(control f11) 'eval-last-sexp)
+;; Edebug is a source-level debugger for Emacs Lisp programs.  Put
+;; the cursor at the end of a function definition and "instrument" it
+;; with this command; then, you can single step through it the next
+;; time it's run.
+(global-set-key '(meta f11) 'edebug-defun)
+(global-set-key '(meta f12) 'add-change-log-entry)
+
+;; This nicely parallels M-*, which pops the tag stack.  See below for
+;; how to set up tags.
+(global-set-key '(control *) 'find-tag-at-point)
+
+;; Define a function to conveniently determine where time is being
+;; spent when executing commands or Lisp code.
+(defun toggle-profiling ()
+  "Start profiling, or stop it and print results.
+This lets you figure out where time is being spent when executing Lisp code."
+  (interactive)  
+  (if (profiling-active-p) 
+      (progn  
+       (stop-profiling) 
+       (message "...Finished profiling")
+       (profile-results))
+    (message "Profiling...") 
+    (clear-profiling-info) 
+    (start-profiling)))
+
+;; Note that sequences of C-c plus a letter are specifically
+;; reserved for users and should never be bound by any packages.
+
+(global-set-key "\C-cp" 'toggle-profiling)
+
+;; LISPM bindings of Control-Shift-C and Control-Shift-E.
+;; See comment above about bindings like this.
+(define-key emacs-lisp-mode-map '(control C) 'compile-defun)
+(define-key emacs-lisp-mode-map '(control E) 'eval-defun)
+
+;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Numeric keypad.
+
+;; The numeric keypad as a whole is underused, and it's a good source
+;; of keys to bind to commands.  Here we add some useful bindings.
+;; Because this is a sample file and I want to avoid unpleasant
+;; surprises for novices, I don't actually bind the shared
+;; numeric/cursor-motion keys because
+;;
+;; (a) someone keypads don't have separate motion keys (e.g. laptops?), and
+;; (b) TTY's and some X servers might not distinguish the regular and
+;;     numeric-keypad motion keys.
+
+;; `kill-current-buffer' (defined below) deletes the current
+;; buffer. (Don't worry, you will be prompted to save if it's
+;; modified.) By repeatedly pressing keypad-minus, you can
+;; conveniently reduce the number of open buffers to a manageable size
+;; after you've opened a whole bunch of files and finished working on
+;; them.  Shift plus keypad-minus kills both the current buffer and
+;; its window, and Control plus keypad-minus kills just the current
+;; window.
+
+(global-set-key 'kp-subtract 'kill-current-buffer)
+(global-set-key '(shift kp-subtract) 'kill-current-buffer-and-window)
+(global-set-key '(control kp-subtract) 'delete-window)
+;; Ugh, modes that use `suppress-keymap' and are dumped with XEmacs will
+;; need their own definition.  There is no easy way to fix this.
+(define-key help-mode-map 'kp-subtract 'kill-current-buffer)
+(define-key help-mode-map '(shift kp-subtract)
+  'kill-current-buffer-and-window)
+(define-key list-mode-map 'kp-subtract 'kill-current-buffer)
+(define-key list-mode-map '(shift kp-subtract)
+  'kill-current-buffer-and-window)
+
+(defun kill-current-buffer ()
+  (interactive)
+  (kill-buffer (current-buffer)))
+
+(defun kill-current-buffer-and-window ()
+  (interactive)
+  (kill-buffer (current-buffer))
+  (delete-window))
+
+(defun grep-c-files ()
+  (interactive)
+  (require 'compile)
+  (let ((grep-command
+        (cons (concat grep-command " *.[chCH]"
+                                       ; i wanted to also use *.cc and *.hh.
+                                       ; see long comment below under Perl.
+                      )
+              (length grep-command))))
+    (call-interactively 'grep)))
+
+(defun grep-lisp-files ()
+  (interactive)
+  (require 'compile)
+  (let ((grep-command
+        (cons (concat grep-command " *.el"
+                                       ; i wanted to also use *.cc and *.hh.
+                                       ; see long comment below under Perl.
+                      )
+              (length grep-command))))
+    (call-interactively 'grep)))
+
+;; This repeatedly selects larger and larger balanced expressions
+;; around the cursor.  Once you have such an expression marked, you
+;; can expand to the end of the following expression with C-M-SPC and
+;; to the beginning of the previous with M-left.
+
+(defun clear-select ()
+  (interactive "_") ;this means "preserve the active region after this command"
+  (backward-up-list 1)
+  (let ((end (save-excursion (forward-sexp) (point))))
+    (push-mark end nil t)))
+
+;; #### no kp-divide because it doesn't (currently) work on MS Windows
+;; -- always reports as /. #### this should be fixable.
+(global-set-key 'kp-add 'query-replace)
+(global-set-key '(shift kp-add) 'query-replace-regexp)
+(global-set-key '(control kp-add) 'grep-c-files)
+(global-set-key '(meta kp-add) 'grep-lisp-files)
+(global-set-key 'clear 'clear-select)
+;; Note that you can use a "lambda" expression (an anonymous function)
+;; in place of a function name.  This function would be called
+;; `pop-local-mark' and lets you repeatedly cycle back through recent
+;; marks (marks are set whenever you begin a selection, begin a
+;; successful search, are about to jump to the beginning or end of the
+;; buffer, etc.).
+(global-set-key 'kp-enter (lambda () (interactive) (set-mark-command t)))
+(global-set-key '(shift kp-enter) 'repeat-complex-command)
+(global-set-key 'pause 'repeat-complex-command) ;; useful on Windows-stlye kbds
+(global-set-key '(control kp-enter) 'eval-expression)
+
+;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Misc.
+
+;; If you want button2 to insert the selected text
+;; at point (where the text cursor is), instead of at the
+;; position clicked, uncomment the following:
+
+;(setq mouse-yank-at-point t)
+
+;; If you like the FSF Emacs binding of button3 (single-click
+;; extends the selection, double-click kills the selection),
+;; uncomment the following:
+
+;(define-key global-map 'button3 'mouse-track-adjust)
+
+;(add-hook 'mouse-track-click-hook
+;          (lambda (event count)
+;            (if (or (/= (event-button event) 3)
+;                    (/= count 2))
+;                nil ;; do the normal operation
+;              (kill-region (point) (mark))
+;              t ;; don't do the normal operations.
+;              )))
+
+;; Uncomment this to enable "sticky modifier keys".  With sticky
+;; modifier keys enabled, you can press and release a modifier key
+;; before pressing the key to be modified, like how the ESC key works
+;; always.  If you hold the modifier key down, however, you still get
+;; the standard behavior.  I personally think this is the best thing
+;; since sliced bread (and a *major* win when it comes to reducing
+;; Emacs pinky), but it's disorienting at first so I'm not enabling it
+;; here by default.
+
+;(setq modifier-keys-are-sticky t)
+
+;; Enable the command `narrow-to-region' ("C-x n n").  It's a useful
+;; command, but possibly confusing to a new user, so it's disabled by
+;; default.
+(put 'narrow-to-region 'disabled nil)
+
+;; Enable obvious hyperlink following with button1.
+(setq Info-button1-follows-hyperlink t)
+
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;                     Change Some Basic Behaviors                  ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Change the values of some variables.
+;; (t means true; nil means false.)
+;;
+;; Use C-h v or `Help->Commands, Variables, Keys->Describe Variable...'
+;; to find out what these variables mean.
+(setq
+ find-file-compare-truenames t
+ minibuffer-max-depth nil
+ )
+
+;; When running ispell, consider all 1-3 character words as correct.
+(setq ispell-extra-args '("-W" "3"))
+
+;;; pending-delete-mode causes typed text to replace a selection,
+;;; rather than append -- standard behavior under all window systems
+;;; nowadays.
+
+(pending-delete-mode 1)
+
+;;; enable region selection with shift+arrows (on by default in 21.5
+;;; and up)
+(setq shifted-motion-keys-select-region t)
+
+;;; NOTE: In this context, `windows-nt' actually refers to all MS
+;;; Windows operating systems!
+(when (eq system-type 'windows-nt)
+  ;; Get mail working under Windows.
+  (setq send-mail-function 'smtpmail-send-it)
+  (setq smtpmail-debug-info t)
+  ;; Substitute your info here.
+  ;(setq user-mail-address "ben@xemacs.org")
+  ;(setq user-full-name "Ben Wing")
+  ;(setq smtpmail-smtp-server "pop.tcsn.uswest.net")
+
+  ;; Make Alt+accelerator traverse to the menu in new enough XEmacs
+  ;; versions.  Note that this only overrides Meta bindings that would
+  ;; actually invoke a menu, and that none of the most common commands
+  ;; are overridden.  You can use ESC+key to access the overridden
+  ;; ones if necessary.
+  (setq menu-accelerator-enabled 'menu-force)
+
+  ;; Make Cygwin `make' work inside a shell buffer.
+  (setenv "MAKE_MODE" "UNIX"))
+
+;; This shows how to set up the XEmacs side of tags. (To create the
+;; TAGS table, use the `etags' program found in the XEmacs bin
+;; directory.  Run it in the root directory of your source tree and
+;; specify all source and include files on the command line.)
+;(setq tag-table-alist
+;      '(
+;      ;; Everywhere in the /src/xemacs/gui/ source tree will use the TAGS
+;      ;; file in /src/xemacs/gui/.
+;      ("/src/xemacs/gui/" . "/src/xemacs/gui/")
+;      ;; Everywhere in the /src/xemacs/mule/ source tree will use the TAGS
+;      ;; file in /src/xemacs/mule/.
+;      ("/src/xemacs/mule/" . "/src/xemacs/mule/")
+;      ;; etc.
+;      ("/src/xemacs/fixup/" . "/src/xemacs/fixup/")
+;      ("/src/emacs/emacs-20.6/" . "/src/emacs/emacs-20.6/")
+;      ("/src/xemacs/latest/" . "/src/xemacs/latest/")
+;      ;; Everywhere else will use the TAGS file in
+;      ;; /src/xemacs/fixup/.
+;      ("" . "/src/xemacs/fixup/")
+;      ))
+
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;               Change Some Aspects of GUI Appearance              ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Changes the text in the window title bar, to switch to MS Windows
+;; format (filename goes first, for best identification in icons) and
+;; add the version and full executable path. (However, it is not
+;; changed unless it currently has the default value, to avoid
+;; interfering with a -wn command line argument I may have started
+;; XEmacs with.)
+
+(if (or (equal frame-title-format "%S: %b")
+       (equal frame-title-format "%b - XEmacs"))
+    (setq frame-title-format
+         (concat "%b - XEmacs "
+                 (progn (string-match "\\(.*?\\)\\( XEmacs Lucid\\)?$"
+                                      emacs-version)
+                        (match-string 1 emacs-version))
+                 " [" invocation-directory invocation-name "]")))
+
+;; Load some nifty sounds that will replace the default beep.
+;;
+;; (Note that sampled sounds only work if XEmacs was compiled with
+;; sound support and we're running on MS Windows, on a machine which
+;; has a NetAudio or ESD server, or on the console of a Linux, Sparc,
+;; HP, or SGI machine.  Otherwise, you just get the standard beep.)
+
+(cond ((or (and (getenv "DISPLAY") 
+               (string-match ":0" (getenv "DISPLAY")))
+          (and (eq (console-type) 'mswindows)
+               (device-sound-enabled-p)))
+       (load-default-sounds)
+       ;; On Windows, at least, the sound "quiet-beep", which is normally
+       ;; given the symbolic name `quiet' and is used for Quit and such,
+       ;; is just totally disgusting.  So make this name correspond to a
+       ;; more innocuous sound.
+       (load-sound-file "drum-beep" 'quiet 80))
+      (t
+       (setq bell-volume 40)
+       (setq sound-alist
+            (append sound-alist '((no-completion :pitch 500))))
+       ))
+
+;; Change the continuation glyph face so it stands out more
+(make-face-bold (glyph-face continuation-glyph))
+
+;; Change the pointer used during garbage collection.
+;;
+;; Note that this pointer image is rather large as pointers go,
+;; and so it won't work on some X servers (such as the MIT
+;; R5 Sun server) because servers may have lamentably small
+;; upper limits on pointer size.
+;;(if (featurep 'xpm)
+;;   (set-glyph-image gc-pointer-glyph
+;;      (expand-file-name "trash.xpm" data-directory)))
+
+;; Here's another way to do that: it first tries to load the
+;; pointer once and traps the error, just to see if it's
+;; possible to load that pointer on this system; if it is,
+;; then it sets gc-pointer-glyph, because we know that
+;; will work.  Otherwise, it doesn't change that variable
+;; because we know it will just cause some error messages.
+(if (featurep 'xpm)
+    (let ((file (expand-file-name "recycle.xpm" data-directory)))
+      (if (condition-case nil
+             ;; check to make sure we can use the pointer.
+             (make-image-instance file nil
+                                  '(pointer))
+           (error nil))                ; returns nil if an error occurred.
+         (set-glyph-image gc-pointer-glyph file))))
+
+;(when (featurep 'menubar)
+;  ;; Add `dired' to the File menu
+;  (add-menu-button '("File") ["Edit Directory" dired])
+
+;  ;; Here's a way to add scrollbar-like buttons to the menubar
+;  (add-menu-button nil ["Top" beginning-of-buffer])
+;  (add-menu-button nil ["<<<" scroll-down])
+;  (add-menu-button nil [" . " recenter])
+;  (add-menu-button nil [">>>" scroll-up])
+;  (add-menu-button nil ["Bot" end-of-buffer]))
+
+;; Here's a cute hack that shows how to programmatically change some
+;; text colors.  It changes the background color of the window if it's
+;; not on the local machine, or if it's running as root:
+
+;; local emacs background:  whitesmoke [i.e. the default color]
+;; remote emacs background: palegreen1
+;; root emacs background:   coral2
+
+;; Uncomment to enable.
+
+;(cond
+; ((and running-xemacs
+;       (console-on-window-system-p)
+;       ;; this does not make much sense on Windows.
+;       (not (eq system-type 'windows-nt)))
+;  (let* ((root-p (eq 0 (user-uid)))
+;       (dpy (or (getenv "DISPLAY") ""))
+;       (remote-p (not
+;                  (or (string-match "^\\(\\|unix\\|localhost\\):" dpy)
+;                      (let ((s (system-name)))
+;                        (if (string-match "\\.\\(netscape\\|mcom\\)\\.com" s)
+;                            (setq s (substring s 0 (match-beginning 0))))
+;                        (string-match (concat "^" (regexp-quote s)) dpy)))))
+;       (bg (cond (root-p "coral2")
+;                 (remote-p "palegreen1")
+;                 (t nil))))
+;    (cond (bg
+;         (let ((def (color-name (face-background 'default)))
+;               (faces (face-list)))
+;           (while faces
+;             (let ((obg (face-background (car faces))))
+;               (if (and obg (equal def (color-name obg)))
+;                   (set-face-background (car faces) bg)))
+;             (setq faces (cdr faces)))))))))
+
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;                      Changing the Modeline                       ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Enable line numbers and column numbers.  This is done in C code now
+;; and is very fast.
+(line-number-mode 1)
+(column-number-mode 1)
+
+;; Rearrange the modeline so that everything is to the left of the
+;; long list of minor modes, which is relatively unimportant but takes
+;; up so much room that anything to the right is obliterated.
+
+(setq-default
+ modeline-format
+ (list
+  ""
+  (if (boundp 'modeline-multibyte-status) 'modeline-multibyte-status "")
+  (cons modeline-modified-extent 'modeline-modified)
+  (cons modeline-buffer-id-extent
+       (list (cons modeline-buffer-id-left-extent
+                   (cons 15 (list
+                             (list 'line-number-mode "L%l ")
+                             (list 'column-number-mode "C%c ")
+                             (cons -3 "%p"))))
+             (cons modeline-buffer-id-right-extent "%17b")))
+  "   "
+  'global-mode-string
+  "   %[("
+  (cons modeline-minor-mode-extent
+       (list "" 'mode-name 'minor-mode-alist))
+  (cons modeline-narrowed-extent "%n")
+  'modeline-process
+  ")%]----"
+  "%-"
+  ))
+
+;; Get rid of modeline information taking up too much space -- in
+;; particular, minor modes that are always enabled.
+(setq pending-delete-modeline-string "")
+(setq filladapt-mode-line-string "")
+;; lazy-lock doesn't have a variable for its modeline name, so we have
+;; to do a bit of surgery.
+(and (assoc 'lazy-lock-mode minor-mode-alist)
+     (setcdr (cdr (cadr (assoc 'lazy-lock-mode minor-mode-alist))) ""))
+
+
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;               Customization of Specific Packages                 ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+;;; ********************
+;;; Load gnuserv, which will allow you to connect to XEmacs sessions
+;;; using `gnuclient'.
+
+;; If you never run more than one XEmacs at a time, you might want to
+;; always start gnuserv.  Otherwise it is preferable to specify
+;; `-f gnuserv-start' on the command line to one of the XEmacsen.
+; (gnuserv-start)
+
+
+;;; ********************
+;;; Load efs, which uses the FTP protocol as a pseudo-filesystem.
+;;; When this is loaded, the pathname syntax /user@host:/remote/path
+;;; refers to files accessible through ftp.
+;;;
+(require 'dired)
+;; compatible ange-ftp/efs initialization derived from code
+;; from John Turner <turner@lanl.gov>
+;;
+;; The environment variable EMAIL_ADDRESS is used as the password
+;; for access to anonymous ftp sites, if it is set.  If not, one is
+;; constructed using the environment variables USER and DOMAINNAME
+;; (e.g. turner@lanl.gov), if set.
+
+(condition-case nil
+    (progn
+      (require 'efs-auto)
+      (if (getenv "USER")
+         (setq efs-default-user (getenv "USER")))
+      (if (getenv "EMAIL_ADDRESS")
+         (setq efs-generate-anonymous-password (getenv "EMAIL_ADDRESS"))
+       (if (and (getenv "USER")
+                (getenv "DOMAINNAME"))
+           (setq efs-generate-anonymous-password
+                 (concat (getenv "USER")"@"(getenv "DOMAINNAME")))))
+      (setq efs-auto-save 1))
+  (error
+   (require 'ange-ftp)
+   (if (getenv "USER")
+       (setq ange-ftp-default-user (getenv "USER")))
+   (if (getenv "EMAIL_ADDRESS")
+       (setq ange-ftp-generate-anonymous-password (getenv "EMAIL_ADDRESS"))
+     (if (and (getenv "USER")
+             (getenv "DOMAINNAME"))
+        (setq ange-ftp-generate-anonymous-password
+              (concat (getenv "USER")"@"(getenv "DOMAINNAME")))))
+   (setq ange-ftp-auto-save 1)
+   ))
+
+
+;;; ********************
+;;; Load the default-dir.el package which installs fancy handling of
+;;; the initial contents in the minibuffer when reading file names.
+
+;(condition-case nil
+;    (require 'default-dir)
+;  (error nil))
+
+
+;;; ********************
+;;; Put all of your autosave files in one place, instead of scattering
+;;; them around the file system.  This has many advantages -- e.g. it
+;;; will eliminate slowdowns caused by editing files on a slow NFS
+;;; server.  (*Provided* that your home directory is local or on a
+;;; fast server!  If not, pick a value for `auto-save-directory' that
+;;; is fast fast fast!)
+;;;
+;;; Unfortunately, the code that implements this (auto-save.el) is
+;;; broken on Windows in 21.4 and earlier.
+(unless (and (eq system-type 'windows-nt)
+            (not (emacs-version>= 21 5)))
+  (setq auto-save-directory (expand-file-name "~/.autosave/")
+       auto-save-directory-fallback auto-save-directory
+       auto-save-hash-p nil
+       efs-auto-save t
+       efs-auto-save-remotely nil
+       ;; now that we have auto-save-timeout, let's crank this up
+       ;; for better interactive response.
+       auto-save-interval 2000
+       )
+  ;; We load this afterwards because it checks to make sure the
+  ;; auto-save-directory exists (creating it if not) when it's loaded.
+  (require 'auto-save)
+  )
+
+
+;;; ********************
+;;; cc-mode (the mode you're in when editing C, C++, and Objective C files)
+
+;; Tell cc-mode not to check for old-style (K&R) function declarations.
+;; This speeds up indenting a lot.
+(setq c-recognize-knr-p nil)
+
+;; Change the indentation amount to 4 spaces instead of 2.
+;; You have to do it in this complicated way because of the
+;; strange way the cc-mode initializes the value of `c-basic-offset'.
+;; (add-hook 'c-mode-hook (lambda () (setq c-basic-offset 4)))
+
+
+;;; ********************
+;;; Load a partial-completion mechanism, which makes minibuffer completion
+;;; search multiple words instead of just prefixes; for example, the command
+;;; `M-x byte-compile-and-load-file RET' can be abbreviated as `M-x b-c-a RET'
+;;; because there are no other commands whose first three words begin with
+;;; the letters `b', `c', and `a' respectively.
+;;;
+(load-library "completer")
+
+
+;;; ********************
+;;; Load crypt, which is a package for automatically decoding and reencoding
+;;; files by various methods - for example, you can visit a .Z or .gz file,
+;;; edit it, and have it automatically re-compressed when you save it again.
+;;; 
+(setq crypt-encryption-type 'pgp   ; default encryption mechanism
+      crypt-confirm-password t    ; make sure new passwords are correct
+      ;crypt-never-ever-decrypt t  ; if you don't encrypt anything, set this to
+                                  ; tell it not to assume that "binary" files
+                                  ; are encrypted and require a password.
+      )
+(require 'crypt)
+
+
+;;; ********************
+;;; Filladapt is a syntax-highlighting package.  When it is enabled it
+;;; makes filling (e.g. using M-q) much much smarter about paragraphs
+;;; that are indented and/or are set off with semicolons, dashes, etc.
+
+(require 'filladapt)
+(setq-default filladapt-mode t)
+(add-hook 'c-mode-hook 'turn-off-filladapt-mode)
+
+
+;;; ********************
+;;; Font-Lock is a syntax-highlighting package.  When it is enabled and you
+;;; are editing a program, different parts of your program will appear in
+;;; different fonts or colors.  For example, with the code below, comments
+;;; appear in red italics, function names in function definitions appear in
+;;; blue bold, etc.  The code below will cause font-lock to automatically be
+;;; enabled when you edit C, C++, Emacs-Lisp, and many other kinds of
+;;; programs.
+;;;
+;;; The "Options" menu has some commands for controlling this as well.
+;;;
+(cond (running-xemacs
+
+;; The commented-out code below is an example of setting up custom
+;; font-lock colors.
+
+;       ;; If you want the default colors, you could do this:
+;       ;; (setq font-lock-use-default-fonts nil)
+;       ;; (setq font-lock-use-default-colors t)
+;       ;; but I want to specify my own colors, so I turn off all
+;       ;; default values.
+;       (setq font-lock-use-default-fonts nil)
+;       (setq font-lock-use-default-colors nil)
+
+       (require 'font-lock)
+
+;       ;; Mess around with the faces a bit.  Note that you have
+;       ;; to change the font-lock-use-default-* variables *before*
+;       ;; loading font-lock, and wait till *after* loading font-lock
+;       ;; to customize the faces.
+
+;       ;; string face is green
+;       (set-face-foreground 'font-lock-string-face "forest green")
+
+;       ;; comments are italic and red; doc strings are italic
+;       (set-face-font 'font-lock-comment-face [italic])
+;       ;; Underlining comments looks terrible on tty's
+;       (set-face-underline-p 'font-lock-comment-face nil 'global 'tty)
+;       (set-face-highlight-p 'font-lock-comment-face t 'global 'tty)
+;       (copy-face 'font-lock-comment-face 'font-lock-doc-string-face)
+;       (set-face-foreground 'font-lock-comment-face "red")
+
+;       ;; function names are bold and blue
+;       (set-face-font 'font-lock-function-name-face [bold])
+;       (set-face-foreground 'font-lock-function-name-face "blue")
+
+;       ;; misc. faces
+;       (set-face-font 'font-lock-preprocessor-face [bold])
+;       (set-face-font 'font-lock-type-face [italic])
+;       (set-face-font 'font-lock-keyword-face [bold])
+       ))
+
+
+;;; ********************
+;;; lazy-lock is a package which speeds up the highlighting of files
+;;; by doing it "on-the-fly" -- only the visible portion of the
+;;; buffer is fontified.  The results may not always be quite as
+;;; accurate as using full font-lock or fast-lock, but it's *much*
+;;; faster.  No more annoying pauses when you load files.
+
+(add-hook 'font-lock-mode-hook 'turn-on-lazy-lock)
+;; I personally don't like "stealth mode" (where lazy-lock starts
+;; fontifying in the background if you're idle for 30 seconds)
+;; because it takes too long to wake up again on my piddly Sparc 1+.
+(setq lazy-lock-stealth-time nil)
+
+
+;;; ********************
+;;; func-menu is a package that scans your source file for function
+;;; definitions and makes a menubar entry that lets you jump to any
+;;; particular function definition by selecting it from the menu.  The
+;;; following code turns this on for all of the recognized languages.
+;;; Scanning the buffer takes some time, but not much.
+;;;
+;;; Send bug reports, enhancements etc to:
+;;; David Hughes <ukchugd@ukpmr.cs.philips.nl>
+;;;
+(cond (running-xemacs
+       (require 'func-menu)
+       (global-set-key '(shift f12) 'function-menu)
+       (add-hook 'find-file-hooks 'fume-add-menubar-entry)
+       (global-set-key "\C-cl" 'fume-list-functions)
+       (global-set-key "\C-cg" 'fume-prompt-function-goto)
+
+       ;; The Hyperbole information manager package uses (shift button2) and
+       ;; (shift button3) to provide context-sensitive mouse keys.  If you
+       ;; use this next binding, it will conflict with Hyperbole's setup.
+       ;; Choose another mouse key if you use Hyperbole.
+       (global-set-key '(shift button3) 'mouse-function-menu)
+
+       ;; For descriptions of the following user-customizable variables,
+       ;; type C-h v <variable>
+       (setq fume-max-items 25
+             fume-fn-window-position 3
+             fume-auto-position-popup t
+             fume-display-in-modeline-p t
+             fume-menubar-menu-name
+            (if (fboundp 'submenu-generate-accelerator-spec)
+                "Function%_s" "Functions")
+             fume-buffer-name "*Function List*"
+             fume-no-prompt-on-valid-default nil)
+       ))
+
+
+;;; ********************
+;;; MH is a mail-reading system from the Rand Corporation that relies on a
+;;; number of external filter programs (which do not come with emacs.)
+;;; Emacs provides a nice front-end onto MH, called "mh-e".
+;;;
+;; Bindings that let you send or read mail using MH
+;(global-set-key "\C-xm"  'mh-smail)
+;(global-set-key "\C-x4m" 'mh-smail-other-window)
+;(global-set-key "\C-cr"  'mh-rmail)
+
+;; Customization of MH behavior.
+(setq mh-delete-yanked-msg-window t)
+(setq mh-yank-from-start-of-msg 'body)
+(setq mh-summary-height 11)
+
+;; Use lines like the following if your version of MH
+;; is in a special place.
+;(setq mh-progs "/usr/dist/pkgs/mh/bin.svr4/")
+;(setq mh-lib "/usr/dist/pkgs/mh/lib.svr4/")
+
+
+;;; ********************
+;;; resize-minibuffer-mode makes the minibuffer automatically
+;;; resize as necessary when it's too big to hold its contents.
+
+(autoload 'resize-minibuffer-mode "rsz-minibuf" nil t)
+(resize-minibuffer-mode)
+(setq resize-minibuffer-window-exactly nil)
+
+
+;;; ********************
+;;; scroll-in-place is a package that keeps the cursor on the same line (and in the same column) when scrolling by a page using PgUp/PgDn.
+
+(require 'scroll-in-place)
+(turn-on-scroll-in-place)
+
+
+;;; ********************
+;;; W3 is a browser for the World Wide Web, and takes advantage of the very
+;;; latest redisplay features in XEmacs.  You can access it simply by typing 
+;;; 'M-x w3'; however, if you're unlucky enough to be on a machine that is 
+;;; behind a firewall, you will have to do something like this first:
+
+;(setq w3-use-telnet t
+;      ;;
+;      ;; If the Telnet program you use to access the outside world is
+;      ;; not called "telnet", specify its name like this.
+;      w3-telnet-prog "itelnet"
+;      ;;
+;      ;; If your Telnet program adds lines of junk at the beginning
+;      ;; of the session, specify the number of lines here.
+;      w3-telnet-header-length 4
+;      )

diff --git a/info/standards.info-4 b/info/standards.info-4
new file mode 100644 (file)
index 0000000..750a7b4
--- /dev/null
+++ b/info/standards.info-4
@@ -0,0 +1,150 @@
+This is ../info/standards.info, produced by makeinfo version 4.0 from
+standards.texi.
+
+START-INFO-DIR-ENTRY
+* Standards: (standards).        GNU coding standards.
+END-INFO-DIR-ENTRY
+
+   GNU Coding Standards Copyright (C) 1992, 1993, 1994, 1995, 1996,
+1997, 1998, 1999, 2000 Free Software Foundation, Inc.
+
+   Permission is granted to make and distribute verbatim copies of this
+manual provided the copyright notice and this permission notice are
+preserved on all copies.
+
+   Permission is granted to copy and distribute modified versions of
+this manual under the conditions for verbatim copying, provided that
+the entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+   Permission is granted to copy and distribute translations of this
+manual into another language, under the above conditions for modified
+versions, except that this permission notice may be stated in a
+translation approved by the Free Software Foundation.
+
+\1f
+File: standards.info,  Node: Index,  Prev: References,  Up: Top
+
+Index
+*****
+
+* Menu:
+
+* #endif, commenting:                    Comments.
+* --help option:                         Command-Line Interfaces.
+* --version option:                      Command-Line Interfaces.
+* -Wall compiler option:                 Syntactic Conventions.
+* accepting contributions:               Contributions.
+* address for bug reports:               Command-Line Interfaces.
+* ANSI C standard:                       Standard C.
+* arbitrary limits on data:              Semantics.
+* autoconf:                              System Portability.
+* avoiding proprietary code:             Reading Non-Free Code.
+* behavior, dependent on program's name: User Interfaces.
+* binary packages:                       Install Command Categories.
+* bindir:                                Directory Variables.
+* braces, in C source:                   Formatting.
+* bug reports:                           Command-Line Interfaces.
+* canonical name of a program:           Command-Line Interfaces.
+* casting pointers to integers:          CPU Portability.
+* change logs:                           Change Logs.
+* change logs, conditional changes:      Conditional Changes.
+* change logs, style:                    Style of Change Logs.
+* command-line arguments, decoding:      Semantics.
+* command-line interface:                Command-Line Interfaces.
+* commenting:                            Comments.
+* compatibility with C and POSIX standards: Compatibility.
+* compiler warnings:                     Syntactic Conventions.
+* conditional changes, and change logs:  Conditional Changes.
+* conditionals, comments for:            Comments.
+* configure:                             Configuration.
+* control-L:                             Formatting.
+* conventions for makefiles:             Makefile Conventions.
+* corba:                                 Graphical Interfaces.
+* credits for manuals:                   Manual Credits.
+* data types, and portability:           CPU Portability.
+* declaration for system functions:      System Functions.
+* documentation:                         Documentation.
+* doschk:                                Names.
+* downloading this manual:               Preface.
+* error messages:                        Semantics.
+* error messages, formatting:            Errors.
+* exec_prefix:                           Directory Variables.
+* expressions, splitting:                Formatting.
+* file usage:                            File Usage.
+* file-name limitations:                 Names.
+* formatting error messages:             Errors.
+* formatting source code:                Formatting.
+* formfeed:                              Formatting.
+* function argument, declaring:          Syntactic Conventions.
+* function prototypes:                   Standard C.
+* getopt:                                Command-Line Interfaces.
+* gettext:                               Internationalization.
+* gnome:                                 Graphical Interfaces.
+* graphical user interface:              Graphical Interfaces.
+* gtk:                                   Graphical Interfaces.
+* GUILE:                                 Source Language.
+* implicit int:                          Syntactic Conventions.
+* impossible conditions:                 Semantics.
+* internationalization:                  Internationalization.
+* legal aspects:                         Legal Issues.
+* legal papers:                          Contributions.
+* libexecdir:                            Directory Variables.
+* libraries:                             Libraries.
+* library functions, and portability:    System Functions.
+* license for manuals:                   License for Manuals.
+* lint:                                  Syntactic Conventions.
+* long option names:                     Option Table.
+* long-named options:                    Command-Line Interfaces.
+* makefile, conventions for:             Makefile Conventions.
+* malloc return value:                   Semantics.
+* man pages:                             Man Pages.
+* manual structure:                      Manual Structure Details.
+* memory allocation failure:             Semantics.
+* memory usage:                          Memory Usage.
+* message text, and internationalization: Internationalization.
+* mmap:                                  Mmap.
+* multiple variables in a line:          Syntactic Conventions.
+* names of variables and functions:      Names.
+* NEWS file:                             NEWS File.
+* non-POSIX systems, and portability:    System Portability.
+* non-standard extensions:               Using Extensions.
+* NUL characters:                        Semantics.
+* open brace:                            Formatting.
+* optional features, configure-time:     Configuration.
+* options for compatibility:             Compatibility.
+* output device and program's behavior:  User Interfaces.
+* packaging:                             Releases.
+* portability, and data types:           CPU Portability.
+* portability, and library functions:    System Functions.
+* portability, between system types:     System Portability.
+* POSIX compatibility:                   Compatibility.
+* POSIXLY_CORRECT, environment variable: Compatibility.
+* post-installation commands:            Install Command Categories.
+* pre-installation commands:             Install Command Categories.
+* prefix:                                Directory Variables.
+* program configuration:                 Configuration.
+* program design:                        Design Advice.
+* program name and its behavior:         User Interfaces.
+* program's canonical name:              Command-Line Interfaces.
+* programming languges:                  Source Language.
+* proprietary programs:                  Reading Non-Free Code.
+* README file:                           Releases.
+* references to non-free material:       References.
+* releasing:                             Managing Releases.
+* sbindir:                               Directory Variables.
+* signal handling:                       Semantics.
+* spaces before open-paren:              Formatting.
+* standard command-line options:         Command-Line Interfaces.
+* standards for makefiles:               Makefile Conventions.
+* string library functions:              System Functions.
+* syntactic conventions:                 Syntactic Conventions.
+* table of long options:                 Option Table.
+* temporary files:                       Semantics.
+* temporary variables:                   Syntactic Conventions.
+* texinfo.tex, in a distribution:        Releases.
+* TMPDIR environment variable:           Semantics.
+* trademarks:                            Trademarks.
+* where to obtain standards.texi:        Preface.
+
+

diff --git a/lisp/ChangeLog.GTK b/lisp/ChangeLog.GTK
new file mode 100644 (file)
index 0000000..c81508f
--- /dev/null
+++ b/lisp/ChangeLog.GTK
@@ -0,0 +1,249 @@
+2000-09-12  William M. Perry  <wmperry@aventail.com>
+
+       * dialog-gtk.el (popup-builtin-open-dialog): Went back to
+       using our lisp implementation of the file dialog.  Much more
+       featureful.
+
+       * ui/gtk-file-dialog.el: Reworked to use CList instead of Tree
+       elements (more like the `real' GTK file selector.
+
+2000-09-10  William M. Perry  <wmperry@aventail.com>
+
+       * gtk-iso8859-1.el (gtk-iso8859-1): Need to actually provide
+       the feature
+
+2000-09-09  William M. Perry  <wmperry@aventail.com>
+
+       * dialog-gtk.el (popup-builtin-open-dialog): Guard against
+       calling gtk-main-quit too many times when destroying the
+       file-selection dialog.
+
+2000-09-08  William M. Perry  <wmperry@aventail.com>
+
+       * gtk-init.el (gtk-initialize-compose): Initialize the compose
+       map like X does.
+
+2000-09-03  William M. Perry  <wmperry@aventail.com>
+
+       * menubar-items.el (default-menubar): Include the font & size
+       menus when running under GTK.
+
+       * gtk-faces.el (x-font-regexp-*): Added variable aliases for
+       the x-font-regexp-* variables.  x-font-menu works now.
+
+       * x-font-menu.el (font-menu-set-font): When setting the font, make
+       sure we don't set the type to 'x' blithely.  This code is shared
+       with GTK now.
+
+2000-08-30  William M. Perry  <wmperry@aventail.com>
+
+       * dialog-gtk.el (popup-builtin-open-dialog): Signal 'quit' if the
+       user hits the cancel button.  This gets rid of the 'wrong type
+       argument: stringp, nil' error.
+
+2000-08-28  William M. Perry  <wmperry@aventail.com>
+
+       * menubar-items.el (default-menubar): Disable the GTK font menu
+       item.
+
+       * dialog-gtk.el (popup-builtin-open-dialog): Reimplemented the
+       file-open dialog to use the normal GTK selector.
+
+2000-07-26  William M. Perry  <wmperry@aventail.com>
+
+       * gtk-init.el (init-post-gtk-win): Define the mule-fonts specifier
+       tag and default fonts for it when mule is provided.  This will
+       make x-symbol.el work.
+
+2000-07-24  William M. Perry  <wmperry@aventail.com>
+
+       * ui/gdk.el: Ditto.
+
+       * ui/gnome-widgets.el: Ditto.
+
+       * ui/gtk-widgets.el: Updated all gtk-import-function calls to pass
+       a symbol instead of a quoted string.
+
+       * ui/gtk-ffi.el (gtk-import-variable): Make gtk-import-variable
+       able to take symbols instead of just strings.  More consistent
+       with gtk-import-function this way.
+
+2000-07-22  William M. Perry  <wmperry@aventail.com>
+
+       * gtk-init.el (init-pre-gtk-win): Did not realize I had to do lisp
+       hackery to get '-unmapped' to work.
+
+2000-07-12  William M. Perry  <wmperry@aventail.com>
+
+       * ui/gtk-widgets.el (gtk-ctree-post-recursive): 
+       (gtk-ctree-post-recursive-to-depth): 
+       (gtk-ctree-pre-recursive): 
+       (gtk-ctree-pre-recursive-to-depth): Added wrappers around the
+       combined gtk-ctree-recurse to make things easier on GTK authors
+       porting other code.
+
+2000-07-11  William M. Perry  <wmperry@aventail.com>
+
+       * gtk-init.el (init-gtk-win): Set gtk-initial-geometry out of
+       command-line-args-left.
+       (gtk-filter-arguments): New function to filter out only GTK/GNOME
+       approved command line arguments.
+       (init-gtk-win): Set gtk-initial-argv-list by filtering it.  This
+       way we get session management/etc from GNOME.
+
+2000-07-07  William M. Perry  <wmperry@aventail.com>
+
+       * gtk-faces.el (gtk-init-global-faces): Make sure to pass in a GTK
+       device (any GTK device) try-font-name when initializing the global
+       faces or it gets confused and cannot find a font, so the code in
+       faces.el ends up setting device-specific faces, which are hard (or
+       at least non-obvious) for users to work around.
+
+2000-07-01  William M. Perry  <wmperry@aventail.com>
+
+       * ui/gtk-widgets.el (GtkType): Added GtkCTree finally.
+
+       * ui/gtk-ffi.el (gtk-ffi-check-function): New function that will
+       try to call a newly defined FFI function and report on whether we
+       need to define any new marshallers for it.
+       (gtk-ffi-debug): If non-nil, then we will check ALL functions that
+       come through gtk-import-function.  All existing imported functions
+       have been checked, and a few missings ones were added.
+
+       * ui/glade.el: New file to import libglade functions.
+
+2000-06-30  William M. Perry  <wmperry@aventail.com>
+
+       * ui/gdk.el: Added most of the GDK drawing primitives.
+
+2000-06-27  William M. Perry  <wmperry@aventail.com>
+
+       * ui/gtk-widgets.el: Import gtk-major-version, gtk-minor-version,
+       gtk-micro-version, gtk-interface-age, and gtk-binary-age.
+
+       * ui/gtk-ffi.el (gtk-import-variable): New macro to import a
+       variable.  Needed to do it as a function, otherwise you could not
+       byte compile / dump the file in a non-windowed XEmacs.
+
+2000-06-23  William M. Perry  <wmperry@aventail.com>
+
+       * menubar-items.el (default-menubar): Disable
+       make-frame-on-display if the function is not available.
+
+2000-06-02  William M. Perry  <wmperry@aventail.com>
+
+       * gtk-mouse.el (gtk-init-pointers): Make sure we set a toolbar
+       pointer.  Looked kind of silly to have the 'xterm' cursor in
+       there by default.
+
+2000-06-01  William M. Perry  <wmperry@aventail.com>
+
+       * ui/gtk-widgets.el: Imported GtkStatusbar
+
+       * ui/gtk-marshal.el (define-marshaller): All marshalling functions
+       are now static.
+       * ui/gtk-marshal.el: Now outputs a function to populate a
+       hashtable with mappings from function name -> function pointer.
+       Also emits the find_marshaller () function that looks at this
+       hashtable.
+
+2000-05-29  William M. Perry  <wmperry@aventail.com>
+
+       * ui/gtk-ffi.el (gtk-import-function): Allow passing in of a
+       symbol for the function name, as well as a string.
+
+       * ui/gtk-widgets.el: Import the GtkSpinButton widget.
+
+2000-05-26  William M. Perry  <wmperry@aventail.com>
+
+       * ui/gtk-ffi.el (gtk-import-function): Rewrote as a macro so that
+       teh file can be safely byte-compiled.  Argument values no longer
+       need to be quoted, and the function is not actually imported until
+       the function is called.  Should save even more on loadup time.
+       (gtk-import-function): Do not defvar `lisp-name' - put the FFI
+       object on the symbols plist.  Makes the lisp variable namespace
+       that much cleaner.
+
+       * ui/gtk-widgets.el: New uber-file containing all the GTK imported
+       functions.  Load time is significantly faster than requiring ~90
+       different (usually 5 line) .el files, and polluting the 'features'
+       variable.
+
+2000-05-23  William M. Perry  <wmperry@aventail.com>
+
+       * ui/gtk-widget-accessors.el (define-widget-accessors): Fixed
+       bogus handling of GTkListOfString and GtkListOfObject slots.
+       These need to have the FULL type, not the fundamental type.  And
+       _POINTER was just plain wrong for them - cause beautiful crashes
+       on linux. :)
+
+       * gtk-faces.el (gtk-choose-font): New function to change fonts
+       based on a GTK font selection dialog.
+
+       * menubar-items.el (default-menubar): Only show the font/size
+       submenus when we are in an X frame.
+       (default-menubar): Show a gtk-specific item when on GTK frames.
+
+       * ui/gtk-marshal.el (define-marshaller): We need to special case
+       anything with FLOAT in the argument list or the parameters get
+       screwed up royally.
+
+2000-05-21  William M. Perry  <wmperry@aventail.com>
+
+       * ui/gtk-file-dialog.el (gtk-file-dialog-fill-file-list): New file
+       dialog that is actually useful and much prettier than the default
+       GTK one.
+
+2000-05-20  William M. Perry  <wmperry@aventail.com>
+
+       * ui/gtk-ffi.el (gtk-import-function): Auto-run gnome-*-get-type
+       routines as well as the gtk-*-get-type ones.
+
+       * minibuf.el (mouse-read-file-name-1): Now tries to use the new
+       builtin dialog spec ben wrote about.  Uses the GTK file selection
+       dialog.  We should be able to come up with something much sexier
+       though - the default dialog box for GTK sucks hard.
+
+2000-05-17  William M. Perry  <wmperry@aventail.com>
+
+       * gtk-faces.el (gtk-init-device-faces): Make use of the extended
+       return values of gtk-style-info.  Set the 'highlight' face to look
+       like GTK_STATE_PRELIGHT and 'zmacs-region' to be
+       GTK_STATE_SELECTED.  Unfortunately these two faces will not
+       automatically be updated because they are not exposed to lisp
+       like Vdefault_face and friends.
+
+2000-05-16  William M. Perry  <wmperry@aventail.com>
+
+       * gtk-faces.el (gtk-init-device-faces): Removed a whole bunch of
+       face munging that is now done down in the guts of the GtkXEmacs
+       widget.
+
+       * gnuserv.el (gnuserv-edit-files): Handle GTK devices.
+
+       * ui/gtk-ffi.el (gtk-import-function): Make this a noop if
+       noninteractive.  This allows us to compile the files during the
+       make process.
+
+2000-05-10  William M. Perry  <wmperry@aventail.com>
+
+       * dialog-gtk.el: New file implementing popup dialogs in Lisp using
+       GTK primitives.  Called from dialog-gtk.c
+
+       * dumped-lisp.el (preloaded-file-list): Make sure we load up
+       menubar-items under GTK.
+       (preloaded-file-list): Load up dialog-gtk when using GTK.
+
+2000-05-08  William M. Perry  <wmperry@aventail.com>
+
+       * ui/gtk-widget-accessors.el (define-widget-accessors): New file
+       to define C functions that go into
+       ../../src/emacs-widget-accessors.c.  This is a hack to get around
+       the lack of accessor/settor functions in GTK for a LOT of things
+       that are required for full functionality (like dialogs)
+
+2000-05-07  William M. Perry  <wmperry@aventail.com>
+
+       * gtk-faces.el (gtk-init-face-from-resources): Set the highlight
+       face as well.
+

diff --git a/lisp/dialog-gtk.el b/lisp/dialog-gtk.el
new file mode 100644 (file)
index 0000000..5cf81c1
--- /dev/null
+++ b/lisp/dialog-gtk.el
@@ -0,0 +1,297 @@
+;;; dialog-gtk.el --- Dialog-box support for XEmacs w/GTK primitives
+
+;; Copyright (C) 2000 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 dialog boxes are compiled in).
+
+(require 'cl)
+(require 'gtk-password-dialog)
+(require 'gtk-file-dialog)
+
+(defun popup-builtin-open-dialog (keys)
+  ;; Allowed keywords are:
+  ;;
+  ;;  :initial-filename fname
+  ;;  :initial-directory dir
+  ;;  :filter-list (filter-desc filter ...)
+  ;;  :directory t/nil
+  ;;  :title string
+  ;;  :allow-multi-select t/nil
+  ;;  :create-prompt-on-nonexistent t/nil
+  ;;  :overwrite-prompt t/nil
+  ;;  :file-must-exist t/nil
+  ;;  :no-network-button t/nil
+  ;;  :no-read-only-return t/nil
+  (let ((initial-filename (plist-get keys :initial-filename))
+       (clicked-ok nil)
+       (filename nil)
+       (widget nil))
+    (setq widget (gtk-file-dialog-new
+                 :directory (plist-get keys :directory)
+                 :callback `(lambda (f)
+                              (setq clicked-ok t
+                                    filename f))
+                 :initial-directory (or (plist-get keys :initial-directory nil)
+                                        (if initial-filename
+                                            (file-name-directory initial-filename)
+                                          default-directory))
+                 :filter-list (plist-to-alist
+                               (plist-get keys :filter-list nil))
+                 :file-must-exist (plist-get keys :file-must-exist nil)))
+
+    (gtk-signal-connect widget 'destroy (lambda (obj data) (gtk-main-quit)))
+
+    (gtk-window-set-transient-for widget (frame-property nil 'shell-widget))
+    (gtk-widget-show-all widget)
+    (gtk-main)
+    (if (not clicked-ok)
+       (signal 'quit nil))))
+
+(defalias 'popup-builtin-save-as-dialog 'popup-builtin-open-dialog)
+
+(defun popup-builtin-color-dialog (keys)
+  ;; Allowed keys:
+  ;;   :initial-color COLOR
+  (let ((initial-color (or (plist-get keys :initial-color) "white"))
+       (title (or (plist-get keys :title "Select color...")))
+       (dialog nil)
+       (clicked-ok nil)
+       (color nil))
+    (setq dialog (gtk-color-selection-dialog-new title))
+    (gtk-signal-connect
+     (gtk-color-selection-dialog-ok-button dialog) 'clicked
+     (lambda (button colorsel)
+       (gtk-widget-hide-all dialog)
+       (setq color (gtk-color-selection-get-color colorsel)
+            clicked-ok t)
+       (gtk-main-quit))
+     (gtk-color-selection-dialog-colorsel dialog))
+
+    (gtk-signal-connect
+     (gtk-color-selection-dialog-cancel-button dialog) 'clicked
+     (lambda (&rest ignored)
+       (gtk-main-quit)))
+
+    (put dialog 'modal t)
+    (put dialog 'type 'dialog)
+    (gtk-window-set-transient-for dialog (frame-property nil 'shell-widget))
+
+    (unwind-protect
+       (progn
+         (gtk-widget-show-now dialog)
+         (gtk-main))
+      '(gtk-widget-destroy dialog))
+    (if (not clicked-ok)
+       (signal 'quit nil))
+    ;; Need to convert from (R G B A) to #rrggbb
+    (format "#%02x%02x%02x"
+           (* 256 (nth 0 color))
+           (* 256 (nth 1 color))
+           (* 256 (nth 2 color)))))
+
+(defun popup-builtin-password-dialog (keys)
+  ;; Format is (default callback :keyword value)
+  ;; Allowed keywords are:
+  ;;
+  ;;  :title string
+  :;  :prompt string
+  ;;  :default string
+  ;;  :verify boolean
+  ;;  :verify-prompt string
+  (let* ((default (plist-get keys :default))
+        (dialog nil)
+        (clicked-ok nil)
+        (passwd nil)
+        (info nil)
+        (generic-cb (lambda (x)
+                      (setq clicked-ok t
+                            passwd x))))
+
+    ;; Convert the descriptor to keywords and create the dialog
+    (setq info (copy-list keys)
+         info (plist-put info :callback generic-cb)
+         info (plist-put info :default default)
+         dialog (apply 'gtk-password-dialog-new info))
+
+    ;; Clicking any button or closing the box exits the main loop.
+    (gtk-signal-connect (gtk-password-dialog-ok-button dialog)
+                       'clicked
+                       (lambda (&rest ignored)
+                         (gtk-main-quit)))
+
+    (gtk-signal-connect (gtk-password-dialog-cancel-button dialog)
+                       'clicked
+                       (lambda (&rest ignored)
+                         (gtk-main-quit)))
+
+    (gtk-signal-connect dialog
+                       'delete-event
+                       (lambda (&rest ignored)
+                         (gtk-main-quit)))
+
+    (gtk-widget-grab-focus (gtk-password-dialog-entry-widget dialog))
+
+    ;; Make us modal...
+    (put dialog 'modal t)
+    (gtk-window-set-transient-for dialog (frame-property nil 'shell-widget))
+
+    ;; Realize the damn thing & wait for some action...
+    (gtk-widget-show-all dialog)
+    (gtk-main)
+
+    (if (not clicked-ok)
+       (signal 'quit nil))
+
+    (gtk-widget-destroy dialog)
+    passwd))
+
+(defun popup-builtin-question-dialog (keys)
+  ;; Allowed keywords:
+  ;;   :question STRING
+  ;;   :buttons  BUTTONDESC
+  (let ((title (or (plist-get keys :title) "Question"))
+       (buttons-descr (plist-get keys :buttons))
+       (question (or (plist-get keys :question) "Question goes here..."))
+       (dialog nil)                    ; GtkDialog
+       (buttons nil)                   ; List of GtkButton objects
+       (activep t)
+       (flushrightp nil)
+       (errp t))
+    (if (not buttons-descr)
+       (error 'syntax-error
+              "Dialog descriptor must supply at least one button"))
+
+    ;; Do the basics - create the dialog, set the window title, and
+    ;; add the label asking the question.
+    (unwind-protect
+       (progn
+         (setq dialog (gtk-dialog-new))
+         (gtk-window-set-title dialog title)
+         (gtk-container-set-border-width dialog 3)
+         (gtk-box-set-spacing (gtk-dialog-vbox dialog) 5)
+         (gtk-container-add (gtk-dialog-vbox dialog) (gtk-label-new question))
+
+         ;; Create the buttons.
+         (mapc (lambda (button)
+                 ;; Handle flushright buttons
+                 (if (null button)
+                     (setq flushrightp t)
+
+                   ;; More sanity checking first of all.
+                   (if (not (vectorp button))
+                       (error "Button descriptor is not a vector: %S" button))
+
+                   (if (< (length button) 3)
+                       (error "Button descriptor is too small: %S" button))
+
+                   (push (gtk-button-new-with-label (aref button 0)) buttons)
+
+                   ;; Need to detect what flavor of descriptor it is.
+                   (if (not (keywordp (aref button 2)))
+                       ;; Simple style... just [ name callback activep ]
+                       ;; We ignore the 'suffix' entry, because that is what
+                       ;; the X code does.
+                       (setq activep (aref button 2))
+                     (let ((ctr 2)
+                           (len (length button)))
+                       (if (logand len 1)
+                           (error
+                            "Button descriptor has an odd number of keywords and values: %S"
+                            button))
+                       (while (< ctr len)
+                         (if (eq (aref button ctr) :active)
+                             (setq activep (aref button (1+ ctr))
+                                   ctr len))
+                         (setq ctr (+ ctr 2)))))
+                   (gtk-widget-set-sensitive (car buttons) (eval activep))
+                   
+                   ;; Apply the callback
+                   (gtk-signal-connect
+                    (car buttons) 'clicked
+                    (lambda (button data)
+                      (push (make-event 'misc-user
+                                        (list 'object (car data)
+                                              'function
+                                              (if (symbolp (car data))
+                                                  'call-interactively
+                                                'eval)))
+                            unread-command-events)
+                      (gtk-main-quit)
+                      t)
+                    (cons (aref button 1) dialog))
+
+                   (gtk-widget-show (car buttons))
+                   (funcall (if flushrightp 'gtk-box-pack-end 'gtk-box-pack-start)
+                            (gtk-dialog-action-area dialog) (car buttons)
+                            nil t 2)))
+               buttons-descr)
+
+         ;; Make sure they can't close it with the window manager
+         (gtk-signal-connect dialog 'delete-event (lambda (&rest ignored) t))
+         (gtk-window-set-transient-for dialog (frame-property nil 'shell-widget))
+         (put dialog 'type 'dialog)
+         (put dialog 'modal t)
+         (gtk-widget-show-all dialog)
+         (gtk-main)
+         (gtk-widget-destroy dialog)
+         (setq errp nil))
+      (if (not errp)
+         ;; Nothing, we successfully showed the dialog
+         nil
+       ;; We need to destroy all the widgets, just in case.
+       (mapc 'gtk-widget-destroy buttons)
+       (gtk-widget-destroy dialog)))))
+
+(defun gtk-make-dialog-box-internal (type keys)
+  (case type
+    (file
+     (popup-builtin-open-dialog keys))
+    (password
+     (popup-builtin-password-dialog keys))
+    (question
+     (popup-builtin-question-dialog keys))
+    (color
+     (popup-builtin-color-dialog keys))
+    (find
+     )
+    (font
+     )
+    (replace
+     )
+    (mswindows-message
+     ;; This should really be renamed!
+     )
+    (print
+     )
+    (page-setup
+     )
+    (print-setup
+     )
+    (default
+      (error "Unknown type of dialog: %S" type))))
+
+(provide 'dialog-gtk)

diff --git a/lisp/gdk.el b/lisp/gdk.el
new file mode 100644 (file)
index 0000000..865fb2d
--- /dev/null
+++ b/lisp/gdk.el
@@ -0,0 +1,149 @@
+;;; gdk.el --- Import GDK functions into XEmacs
+
+;; Copyright (C) 2000 Free Software Foundation
+
+;; Maintainer: William Perry <wmperry@gnu.org>
+;; Keywords: extensions, 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, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+;; This file is dumped with XEmacs.
+
+(eval-and-compile
+  (require 'gtk-ffi))
+
+(gtk-import-function nil gdk_set_show_events (gboolean . show_events))
+(gtk-import-function nil gdk_set_use_xshm (gboolean . use_xshm))
+(gtk-import-function GtkString gdk_get_display)
+(gtk-import-function nil gdk_flush)
+(gtk-import-function nil gdk_beep)
+
+(gtk-import-function nil gdk_key_repeat_disable)
+(gtk-import-function nil gdk_key_repeat_restore)
+
+(gtk-import-function gint gdk_visual_get_best_depth)
+(gtk-import-function GdkVisualType gdk_visual_get_best_type)
+(gtk-import-function GdkVisual gdk_visual_get_system)
+(gtk-import-function GdkVisual gdk_visual_get_best)
+(gtk-import-function GdkVisual gdk_visual_get_best_with_depth (gint . depth))
+(gtk-import-function GdkVisual gdk_visual_get_best_with_type (GdkVisualType . visual_type))
+(gtk-import-function GdkVisual gdk_visual_get_best_with_both
+                    (gint . depth)
+                    (GdkVisualType . visual_type))
+
+(gtk-import-function gboolean gdk_window_is_visible (GdkWindow . window))
+(gtk-import-function gboolean gdk_window_is_viewable (GdkWindow . window))
+
+(gtk-import-function gboolean gdk_window_set_static_gravities
+                    (GdkWindow . window)
+                    (gboolean  . use_static))
+
+(gtk-import-function nil gdk_window_set_cursor
+                    (GdkWindow . window)
+                    (GdkCursor . cursor))
+
+(gtk-import-function GdkVisual gdk_window_get_visual (GdkWindow . window))
+(gtk-import-function GdkWindowType gdk_window_get_type (GdkWindow . window))
+(gtk-import-function GdkWindow gdk_window_get_parent (GdkWindow . window))
+(gtk-import-function GdkWindow gdk_window_get_toplevel (GdkWindow . window))
+(gtk-import-function GdkEventMask gdk_window_get_events (GdkWindow . window))
+(gtk-import-function none gdk_window_set_events (GdkWindow . window) (GdkEventMask . events))
+(gtk-import-function none gdk_window_set_icon
+                    (GdkWindow . window)
+                    (GdkWindow . icon_window)
+                    (GdkPixmap . pixmap)
+                    (GdkBitmap . mask))
+(gtk-import-function none gdk_window_set_icon_name (GdkWindow . window) (GtkString . name))
+(gtk-import-function none gdk_window_set_group (GdkWindow . window) (GdkWindow . leader))
+(gtk-import-function none gdk_window_set_decorations
+                    (GdkWindow . window)
+                    (GdkWMDecoration . decorations))
+(gtk-import-function none gdk_window_set_functions
+                    (GdkWindow . window)
+                    (GdkWMFunction . functions))
+
+;; Cursors are handled by glyphs in XEmacs
+;; GCs are handled by faces in XEmacs
+;; Pixmaps are handled by glyphs in XEmacs
+;; Images are handled by glyphs in XEmacs
+;; Colors are handled natively by XEmacs
+;; Fonts are handled natively by XEmacs
+
+(gtk-import-function none gdk_draw_point
+                    (GdkDrawable . drawable)
+                    (GdkGC . gc)
+                    (gint . x)
+                    (gint . y))
+(gtk-import-function none gdk_draw_line
+                    (GdkDrawable . drawable)
+                    (GdkGC . gc)
+                    (gint . x1)
+                    (gint . y1)
+                    (gint . x2)
+                    (gint . y2))
+(gtk-import-function none gdk_draw_rectangle
+                    (GdkDrawable . drawable)
+                    (GdkGC . gc)
+                    (gboolean . filled)
+                    (gint . x)
+                    (gint . y)
+                    (gint . width)
+                    (gint . height))
+(gtk-import-function none gdk_draw_arc
+                    (GdkDrawable . drawable)
+                    (GdkGC . gc)
+                    (gboolean . filled)
+                    (gint . x)
+                    (gint . y)
+                    (gint . width)
+                    (gint . height)
+                    (gint . angle1)
+                    (gint . angle2))
+(gtk-import-function none gdk_draw_string
+                    (GdkDrawable . drawable)
+                    (GdkFont     . font)
+                    (GdkGC       . gc)
+                    (gint        . x)
+                    (gint        . y)
+                    (GtkString   . string))
+(gtk-import-function none gdk_draw_text
+                    (GdkDrawable . drawable)
+                    (GdkFont     . font)
+                    (GdkGC       . gc)
+                    (gint        . x)
+                    (gint        . y)
+                    (GtkString   . string)
+                    (gint        . text_length))
+(gtk-import-function none gdk_draw_pixmap
+                    (GdkDrawable . drawable)
+                    (GdkGC       . gc)
+                    (GdkImage    . image)
+                    (gint        . xsrc)
+                    (gint        . ysrc)
+                    (gint        . xdest)
+                    (gint        . ydest)
+                    (gint        . width)
+                    (gint        . height))
+
+;; Selections are handled natively by XEmacs
+
+(provide 'gdk)

diff --git a/lisp/generic-widgets.el b/lisp/generic-widgets.el
new file mode 100644 (file)
index 0000000..d918c90
--- /dev/null
+++ b/lisp/generic-widgets.el
@@ -0,0 +1,330 @@
+;;; generic-widgets.el --- Generic UI building
+
+;; Copyright (C) 2000 Free Software Foundation
+
+;; Maintainer: William Perry <wmperry@gnu.org>
+;; Keywords: extensions, 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, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+;; This file is dumped with XEmacs.
+
+(defun build-ui (ui)
+  (if (null ui)
+      (gtk-label-new "[empty]")
+    (let ((builder-func (intern-soft (format "build-ui::%s" (car ui))))
+         (widget nil))
+      (if (and builder-func (fboundp builder-func))
+         (progn
+           (setq widget (funcall builder-func ui))
+           (setcdr ui (plist-put (cdr ui) :x-internal-widget widget))
+           widget)
+       (error "Unknown ui element: %s" (car ui))))))
+
+(defun show-ui (ui)
+  (let ((widget (plist-get (cdr ui) :x-internal-widget)))
+    (if (not widget)
+       (error "Attempting to show unrealized UI"))
+    (gtk-widget-show-all widget)
+    (gtk-signal-connect widget 'destroy
+                       (lambda (widget ui)
+                         (setcdr ui (plist-put (cdr ui) :x-internal-widget nil))) ui)))
+
+
+(defun build-ui::window (spec)
+  "Create a top-level window for containing other widgets.
+Properties:
+:items         list                    A list of child UI specs.  Only the first is used.
+:type          toplevel/dialog/popup   What type of window to create.  Window managers
+                                       can (and usually do) treat each type differently.
+"
+  (let ((plist (cdr spec))
+       (window nil)
+       (child nil))
+    (setq window (gtk-window-new (plist-get plist :type 'toplevel))
+         child (build-ui (car (plist-get plist :items))))
+    (gtk-container-add window child)
+    window))
+
+(defun build-ui::box (spec)
+  "Create a box for containing other widgets.
+Properties:
+:items         list                    A list of child UI specs.
+:homogeneous   t/nil                   Whether all children are the same width/height.
+:spacing       number                  Spacing between children.
+:orientation   horizontal/vertical     How the widgets are stacked.
+
+Additional properties on child widgets:
+:expand                t/nil           Whether the new child is to be given extra space
+                               allocated to box. The extra space will be divided
+                               evenly between all children of box that use this
+                               option.
+:fill          t/nil           Whether space given to child by the expand option is
+                               actually allocated to child, rather than just padding
+                               it. This parameter has no effect if :expand is set to
+                               nil. A child is always allocated the full height of a
+                               horizontal box and the full width of a vertical box.
+                               This option affects the other dimension.
+:padding       number          Extra padding around this widget.
+"
+  (let* ((plist (cdr spec))
+        (orientation (plist-get plist :orientation 'horizontal))
+        (children (plist-get plist :items))
+        (box nil)
+        (child-widget nil)
+        (child-plist nil))
+    (case orientation
+      (vertical (setq box (gtk-vbox-new (plist-get plist :homogeneous)
+                                       (plist-get plist :spacing))))
+      (horizontal (setq box (gtk-hbox-new (plist-get plist :homogeneous)
+                                         (plist-get plist :spacing))))
+      (otherwise (error "Unknown orientation for box: %s" orientation)))
+    (mapc
+     (lambda (child)
+       (setq child-plist (cdr child)
+            child-widget (build-ui child))
+       (if (listp child-widget)
+          (mapc (lambda (w)
+                  (gtk-box-pack-start box w
+                                      (plist-get child-plist :expand)
+                                      (plist-get child-plist :fill)
+                                      (plist-get child-plist :padding))) child-widget)
+        (gtk-box-pack-start box child-widget
+                            (plist-get child-plist :expand)
+                            (plist-get child-plist :fill)
+                            (plist-get child-plist :padding))))
+     children)
+    box))
+
+(defun build-ui::tab-control (spec)
+  "Create a notebook widget.
+Properties:
+:items         list            A list of UI specs to use as notebook pages.
+:homogeneous   t/nil           Whether all tabs are the same width.
+:orientation   top/bottom/left/right   Position of tabs
+:show-tabs     t/nil           Show the tabs on screen?
+:scrollable    t/nil           Allow scrolling to view all tab widgets?
+
+Additional properties on child widgets:
+:tab-label     ui              A UI spec to use for the tab label.
+"
+  (let* ((plist (cdr spec))
+        (notebook (gtk-notebook-new))
+        (children (plist-get plist :items))
+        (page-counter 1)
+        (label-widget nil)
+        (child-widget nil)
+        (child-plist nil))
+    ;; Set all the properties
+    (gtk-notebook-set-homogeneous-tabs notebook (plist-get plist :homogeneous))
+    (gtk-notebook-set-scrollable notebook (plist-get plist :scrollable t))
+    (gtk-notebook-set-show-tabs notebook (plist-get plist :show-tabs t))
+    (gtk-notebook-set-tab-pos notebook (plist-get plist :orientation 'top))
+
+    ;; Now fill in the tabs
+    (mapc
+     (lambda (child)
+       (setq child-plist (cdr child)
+            child-widget (build-ui child)
+            label-widget (build-ui (plist-get child-plist :tab-label
+                                              (list 'label :text (format "tab %d" page-counter))))
+            page-counter (1+ page-counter))
+       (gtk-notebook-append-page notebook child-widget label-widget))
+     children)
+    notebook))
+
+(defun build-ui::text (spec)
+  "Create a multi-line text widget.
+Properties:
+:editable      t/nil           Whether the user can change the contents
+:word-wrap     t/nil           Automatic word wrapping?
+:line-wrap     t/nil           Automatic line wrapping?
+:text          string          Initial contents of the widget
+:file          filename        File for initial contents (takes precedence over :text)
+:face          facename        XEmacs face to use in the widget.
+"
+  (let* ((plist (cdr spec))
+        (text (gtk-text-new nil nil))
+        (face (plist-get plist :face 'default))
+        (info (plist-get plist :text))
+        (file (plist-get plist :file)))
+    (gtk-text-set-editable text (plist-get plist :editable))
+    (gtk-text-set-word-wrap text (plist-get plist :word-wrap))
+    (gtk-text-set-line-wrap text (plist-get plist :line-wrap))
+    (gtk-widget-set-style text 'default)
+
+    ;; Possible convert the file portion
+    (if (and file (not (stringp file)))
+       (setq file (eval file)))
+
+    (if (and info (not (stringp info)))
+       (setq info (eval info)))
+
+    (if (and file (file-exists-p file) (file-readable-p file))
+       (save-excursion
+         (set-buffer (get-buffer-create " *improbable buffer name*"))
+         (insert-file-contents file)
+         (setq info (buffer-string))))
+
+    (gtk-text-insert text
+                    (face-font face)
+                    (face-foreground face)
+                    (face-background face)
+                    info (length info))
+    text))
+
+(defun build-ui::label (spec)
+  "Create a label widget.
+Properties:
+:text          string                  Text inside the label
+:face          facename                XEmacs face to use in the widget.
+:justification  right/left/center      How to justify the text.
+"
+  (let* ((plist (cdr spec))
+        (label (gtk-label-new (plist-get plist :text))))
+    (gtk-label-set-line-wrap label t)
+    (gtk-label-set-justify label (plist-get plist :justification))
+    (gtk-widget-set-style label (plist-get plist :face 'default))
+    label))
+
+(defun build-ui::pixmap (spec)
+  "Create a multi-line text widget.
+Properties:
+:text          string                  Text inside the label
+:face          facename                XEmacs face to use in the widget.
+:justification  right/left/center      How to justify the text.
+"
+  (let* ((plist (cdr spec))
+        (label (gtk-label-new (plist-get plist :text))))
+    (gtk-label-set-line-wrap label t)
+    (gtk-label-set-justify label (plist-get plist :justification))
+    (gtk-widget-set-style label (plist-get plist :face 'default))
+    label))
+
+(defun build-ui::radio-group (spec)
+  "A convenience when specifying a group of radio buttons."
+  (let ((build-ui::radio-group nil))
+    (mapcar 'build-ui (plist-get (cdr spec) :items))))
+
+(defun build-ui::button (spec)
+  "Create a button widget.
+Properties:
+:type          radio/check/toggle/nil  What type of button to create.
+:text          string                  Text in the button.
+:glyph         glyph                   Image in the button.
+:label         ui                      A UI spec to use for the label.
+:relief                normal/half/none        How to draw button edges.
+
+NOTE: Radio buttons must be in a radio-group object for them to work.
+"
+  (let ((plist (cdr spec))
+       (button nil)
+       (button-type (plist-get plist :type 'normal))
+       (label nil))
+    (case button-type
+      (radio
+       (if (not (boundp 'build-ui::radio-group))
+          (error "Attempt to use a radio button outside a radio-group"))
+       (setq button (gtk-radio-button-new build-ui::radio-group)
+            build-ui::radio-group (gtk-radio-button-group button)))
+      (check
+       (setq button (gtk-check-button-new)))
+      (toggle
+       (setq button (gtk-toggle-button-new)))
+      (normal
+       (setq button (gtk-button-new)))
+      (otherwise
+       (error "Unknown button type: %s" button-type)))
+    (gtk-container-add
+     button
+     (build-ui (plist-get plist :label
+                         (list 'label :text
+                               (plist-get plist
+                                          :text (format "%s button" button-type))))))
+    button))
+
+(defun build-ui::progress-gauge (spec)
+  "Create a progress meter.
+Properties:
+:orientation           left-to-right/right-to-left/top-to-bottom/bottom-to-top
+:type                  discrete/continuous
+
+"
+  (let ((plist (cdr spec))
+       (gauge (gtk-progress-bar-new)))
+    (gtk-progress-bar-set-orientation gauge (plist-get plist :orientation 'left-to-right))
+    (gtk-progress-bar-set-bar-style gauge (plist-get plist :type 'continuous))
+    gauge))
+
+(provide 'generic-widgets)
+
+(when (featurep 'gtk)                  ; just loading this file should be OK
+(gtk-widget-show-all
+  (build-ui
+   '(window :type dialog
+           :items ((tab-control
+                    :homogeneous t
+                    :orientation bottom
+                    :items ((box :orientation vertical
+                                 :tab-label (label :text "vertical")
+                                 :items ((label :text "Vertical")
+                                         (progress-gauge)                                        
+                                         (label :text "Box stacking")))
+                            (box :orientation horizontal
+                                 :spacing 10
+                                 :items ((label :text "Horizontal box")
+                                         (label :text "stacking")))
+
+                            (box :orientation vertical
+                                 :items
+                                 ((radio-group
+                                   :items ((button :type radio
+                                                   :expand nil
+                                                   :fill nil
+                                                   :text "Item 1")
+                                           (button :type radio
+                                                   :expand nil
+                                                   :fill nil
+                                                   :text "Item 2")
+                                           (button :type radio
+                                                   :expand nil
+                                                   :fill nil
+                                                   :text "Item 3")
+                                           (button :type radio
+                                                   :expand nil
+                                                   :fill nil)))))
+                            (box :orientation vertical
+                                 :items ((button :type check
+                                                 :text "Item 1")
+                                         (button :type check
+                                                 :text "Item 2")
+                                         (button :type normal
+                                                 :text "Item 3")
+                                         (button :type toggle)))
+                            (text :editable t
+                                  :word-wrap t
+                                  :file (locate-data-file "COPYING"))
+                            (text :editable t
+                                  :face display-time-mail-balloon-enhance-face
+                                  :word-wrap t
+                                  :text "Text with a face on it")))))))
+)

diff --git a/lisp/glade.el b/lisp/glade.el
new file mode 100644 (file)
index 0000000..ec4dcd0
--- /dev/null
+++ b/lisp/glade.el
@@ -0,0 +1,65 @@
+;;; glade.el --- Import libglade functions into XEmacs
+
+;; Copyright (C) 2000 Free Software Foundation
+
+;; Maintainer: William Perry <wmperry@gnu.org>
+;; Keywords: extensions, 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, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+;; This file is dumped with XEmacs (if glade was detected)
+
+(eval-and-compile
+  (require 'gtk-ffi))
+
+(gtk-import-function none glade_init)
+(gtk-import-function none glade_gnome_init)
+(gtk-import-function none glade_bonobo_init)
+(gtk-import-function none glade_load_module (GtkString . module))
+(gtk-import-function GtkType glade_xml_get_type)
+(gtk-import-function GtkObject glade_xml_new
+                    (GtkString . filename)
+                    (GtkString . root))
+(gtk-import-function GladeXML glade_xml_new_with_domain
+                    (GtkString . filename)
+                    (GtkString . root)
+                    (GtkString . domain))
+(gtk-import-function GladeXML glade_xml_new_from_memory
+                    (GtkString . buffer)
+                    (gint      . size)
+                    (GtkString . root)
+                    (GtkString . domain))
+(gtk-import-function gboolean glade_xml_construct
+                    (GladeXML . self)
+                    (GtkString . filename)
+                    (GtkString . root)
+                    (GtkString . domain))
+(gtk-import-function GtkWidget glade_xml_get_widget
+                    (GladeXML . xml)
+                    (GtkString . name))
+(gtk-import-function GtkWidget glade_xml_get_widget_by_long_name
+                    (GladeXML . xml)
+                    (GtkString . longname))
+
+(gtk-import-function GtkString glade_get_widget_name (GtkWidget . widget))
+(gtk-import-function GtkString glade_get_widget_long_name (GtkWidget . widget))
+(gtk-import-function GladeXML glade_get_widget_tree (GtkWidget . widget))

diff --git a/lisp/gnome-widgets.el b/lisp/gnome-widgets.el
new file mode 100644 (file)
index 0000000..0816644
--- /dev/null
+++ b/lisp/gnome-widgets.el
@@ -0,0 +1,1006 @@
+;;; gnome-widgets.el --- Import GNOME functions into XEmacs
+
+;; Copyright (C) 2000 Free Software Foundation
+
+;; Maintainer: William Perry <wmperry@gnu.org>
+;; Keywords: extensions, 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, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+;; This file is dumped with XEmacs.
+
+(eval-and-compile
+  (require 'gtk-ffi))
+
+(gtk-import-function GtkType gnome_about_get_type)
+(gtk-import-function GtkWidget gnome_about_new
+                    (GtkString . title)
+                    (GtkString . version)
+                    (GtkString . copyright)
+                    (GtkArrayOfString  . authors)
+                    (GtkString . comments)
+                    (GtkString . logo))
+
+\f
+(gtk-import-function GtkType gnome_app_get_type)
+
+;; Create a new (empty) application window.  You must specify the
+;; application's name (used internally as an identifier).  The window
+;; title can be left as NULL, in which case the window's title will
+;; not be set.
+(gtk-import-function GtkWidget gnome_app_new
+                    (GtkString . appname)
+                    (GtkString . title))
+
+;; Constructor for language bindings; you don't normally need this.
+(gtk-import-function nil gnome_app_construct
+                    (GnomeApp  . app)
+                    (GtkString . appname)
+                    (GtkString . title))
+
+;; Sets the menu bar of the application window
+(gtk-import-function nil gnome_app_set_menus
+                    (GnomeApp   . app)
+                    (GtkMenuBar . menubar))
+
+;; Sets the main toolbar of the application window
+(gtk-import-function nil gnome_app_set_toolbar
+                    (GnomeApp   . app)
+                    (GtkToolbar . toolbar))
+
+;; Sets the status bar of the application window
+(gtk-import-function nil gnome_app_set_statusbar
+                    (GnomeApp   . app)
+                    (GtkWidget  . statusbar))
+
+;; Sets the status bar of the application window, but uses the given
+;; container widget rather than creating a new one.
+(gtk-import-function nil gnome_app_set_statusbar_custom
+                    (GnomeApp   . app)
+                    (GtkWidget  . container)
+                    (GtkWidget  . statusbar))
+
+;; Sets the content area of the application window
+(gtk-import-function nil gnome_app_set_contents
+                    (GnomeApp   . app)
+                    (GtkWidget  . contents))
+
+(gtk-import-function nil gnome_app_add_toolbar
+                    (GnomeApp              . app)
+                    (GtkToolbar            . toolbar)
+                    (GtkString             . name)
+                    (GnomeDockItemBehavior . behavior)
+                    (GnomeDockPlacement    . placement)
+                    (gint                  . band_num)
+                    (gint                  . band_position)
+                    (gint                  . offset))
+
+(gtk-import-function nil gnome_app_add_docked
+                    (GnomeApp              . app)
+                    (GtkWidget             . toolbar)
+                    (GtkString             . name)
+                    (GnomeDockItemBehavior . behavior)
+                    (GnomeDockPlacement    . placement)
+                    (gint                  . band_num)
+                    (gint                  . band_position)
+                    (gint                  . offset))
+
+(gtk-import-function nil gnome_app_add_dock_item
+                    (GnomeApp              . app)
+                    (GnomeDockItem         . item)
+                    (GnomeDockPlacement    . placement)
+                    (gint                  . band_num)
+                    (gint                  . band_position)
+                    (gint                  . offset))
+
+(gtk-import-function nil gnome_app_enable_layout_config
+                    (GnomeApp . app)
+                    (gboolean . enable))
+
+(gtk-import-function GnomeDock gnome_app_get_dock
+                    (GnomeApp . app))
+(gtk-import-function GnomeDockItem gnome_app_get_dock_item_by_name
+                    (GnomeApp  . app)
+                    (GtkString . name))
+
+\f
+(gtk-import-function GtkType gnome_appbar_get_type)
+
+(gtk-import-function GtkWidget gnome_appbar_new
+                    (gboolean . has_progress)
+                    (gboolean . has_status)
+                    (GnomePreferencesType . interactivity))
+
+;; Sets the status label without changing widget state; next set or push
+;; will destroy this permanently.
+(gtk-import-function nil gnome_appbar_set_status
+                    (GnomeAppBar . appbar)
+                    (GtkString   . status))
+
+;; What to show when showing nothing else; defaults to nothing
+(gtk-import-function nil gnome_appbar_set_default
+                    (GnomeAppBar . appbar)
+                    (GtkString   . default_status))
+
+(gtk-import-function nil gnome_appbar_push
+                    (GnomeAppBar . appbar)
+                    (GtkString   . status))
+
+;; OK to call on empty stack
+(gtk-import-function nil gnome_appbar_pop
+                    (GnomeAppBar . appbar))
+
+;; Nuke the stack.
+(gtk-import-function nil gnome_appbar_clear_stack
+                    (GnomeAppBar . appbar))
+
+;; pure sugar - with a bad name, in light of the get_progress name
+;; which is not the opposite of set_progress. Maybe this function
+;; should die
+(gtk-import-function nil gnome_appbar_set_progress
+                    (GnomeAppBar . appbar)
+                    (gfloat      . percentage))
+
+;; use GtkProgress functions on returned value
+(gtk-import-function GtkProgress gnome_appbar_get_progress
+                    (GnomeAppBar . appbar))
+
+;; Reflect the current state of stack/default. Useful to force a set_status
+;; to disappear.
+(gtk-import-function nil gnome_appbar_refresh
+                    (GnomeAppBar . appbar))
+
+;; Put a prompt in the appbar and wait for a response. When the 
+;; user responds or cancels, a user_response signal is emitted.
+(gtk-import-function nil gnome_appbar_set_prompt
+                    (GnomeAppBar . appbar)
+                    (GtkString   . prompt)
+                    (gboolean    . modal))
+
+;; Remove any prompt
+(gtk-import-function nil gnome_appbar_clear_prompt
+                    (GnomeAppBar . appbar))
+
+;; Get the response to the prompt, if any. Result must be g_free'd.
+(gtk-import-function GtkString gnome_appbar_get_response
+                    (GnomeAppBar . appbar))
+
+\f
+(gtk-import-function GtkType gnome_calculator_get_type)
+(gtk-import-function GtkWidget gnome_calculator_new)
+(gtk-import-function nil gnome_calculator_clear
+                    (GnomeCalculator . gc)
+                    (gboolean        . reset))
+
+(gtk-import-function nil gnome_calculator_set
+                    (GnomeCalculator . gc)
+                    (gdouble         . result))
+
+\f
+;; Standard Gtk function
+(gtk-import-function GtkType gnome_color_picker_get_type)
+
+;; Creates a new color picker widget
+(gtk-import-function GtkWidget gnome_color_picker_new)
+
+;; Set/get the color in the picker.  Values are in [0.0, 1.0]
+(gtk-import-function nil gnome_color_picker_set_d
+                    (GnomeColorPicker . cp)
+                    (gdouble . r)
+                    (gdouble . g)
+                    (gdouble . b)
+                    (gdouble . a))
+
+;; #### BILL!!!  Need multiple return values
+;; void gnome_color_picker_get_d (GnomeColorPicker *cp, gdouble *r, gdouble *g, gdouble *b, gdouble *a)
+
+;; Set/get the color in the picker.  Values are in [0, 255]
+(gtk-import-function nil gnome_color_picker_set_i8
+                    (GnomeColorPicker . cp)
+                    (guint . r)
+                    (guint . g)
+                    (guint . b)
+                    (guint . a))
+
+;; #### BILL!!! Need multiple return values
+;; void gnome_color_picker_get_i8 (GnomeColorPicker *cp, guint8 *r, guint8 *g, guint8 *b, guint8 *a);
+
+;; Set/get the color in the picker.  Values are in [0, 65535]
+(gtk-import-function nil gnome_color_picker_set_i16
+                    (GnomeColorPicker . cp)
+                    (guint . r)
+                    (guint . g)
+                    (guint . b)
+                    (guint . a))
+
+;; #### BILL!!! Need multiple return values
+;; void gnome_color_picker_get_i16 (GnomeColorPicker *cp, gushort *r, gushort *g, gushort *b, gushort *a);
+
+;; Sets whether the picker should dither the color sample or just paint a solid rectangle
+(gtk-import-function nil gnome_color_picker_set_dither
+                    (GnomeColorPicker . cp)
+                    (gboolean         . dither))
+
+;; Sets whether the picker should use the alpha channel or not
+(gtk-import-function nil gnome_color_picker_set_use_alpha
+                    (GnomeColorPicker . cp)
+                    (gboolean         . use_alpha))
+
+;; Sets the title for the color selection dialog
+(gtk-import-function nil gnome_color_picker_set_title
+                    (GnomeColorPicker . cp)
+                    (GtkString        . title))
+
+\f
+(gtk-import-function GtkType gnome_date_edit_get_type)
+(gtk-import-function GtkWidget gnome_date_edit_new
+                    (time_t   . the_time)
+                    (gboolean . show_time)
+                    (gboolean . use_24_format))
+
+(gtk-import-function GtkWidget gnome_date_edit_new_flags
+                    (time_t . the_time)
+                    (GnomeDateEditFlags . flags))
+
+(gtk-import-function nil gnome_date_edit_set_time
+                    (GnomeDateEdit . gde)
+                    (time_t        . the_time))
+
+(gtk-import-function nil gnome_date_edit_set_popup_range
+                    (GnomeDateEdit . gde)
+                    (guint         . low_hour)
+                    (guint         . up_hour))
+
+(gtk-import-function 'time_t gnome_date_edit_get_date
+                    (GnomeDateEdit . gde))
+
+(gtk-import-function nil gnome_date_edit_set_flags
+                    (GnomeDateEdit      . gde)
+                    (GnomeDateEditFlags . flags))
+
+(gtk-import-function GnomeDateEditFlags gnome_date_edit_get_flags
+                    (GnomeDateEdit . gde))
+
+\f
+(gtk-import-function GtkType gnome_dentry_edit_get_type)
+
+;; create a new dentry and get the children using the below macros
+;; or use the utility new_notebook below
+(gtk-import-function GtkObject gnome_dentry_edit_new)
+
+;;#define gnome_dentry_edit_child1(d) (GNOME_DENTRY_EDIT(d)->child1)
+;;#define gnome_dentry_edit_child2(d) (GNOME_DENTRY_EDIT(d)->child2)
+
+;; Create a new edit in this notebook - appends two pages to the 
+;; notebook.
+(gtk-import-function GtkObject gnome_dentry_edit_new_notebook
+                    (GtkNotebook . notebook))
+
+(gtk-import-function nil gnome_dentry_edit_clear
+                    (GnomeDEntryEdit . dee))
+
+;; The GnomeDEntryEdit does not store a dentry, and it does not keep
+;; track of the location field of GnomeDesktopEntry which will always
+;; be NULL.
+
+;; Make the display reflect dentry at path
+(gtk-import-function nil gnome_dentry_edit_load_file
+                    (GnomeDEntryEdit . dee)
+                    (GtkString       . path))
+
+;; Copy the contents of this dentry into the display
+'(gtk-import-function nil gnome_dentry_edit_set_dentry
+                    (GnomeDEntryEdit . dee)
+                    (GnomeDesktopEntry . dentry))
+
+;; Generate a dentry based on the contents of the display
+'(gtk-import-function GnomeDesktopEntry gnome_dentry_edit_get_dentry
+                     (GnomeDEntryEdit . dee))
+
+;; Return an allocated string, you need to g_free it.
+(gtk-import-function GtkString gnome_dentry_edit_get_icon
+                    (GnomeDEntryEdit . dee))
+(gtk-import-function GtkString gnome_dentry_edit_get_name
+                    (GnomeDEntryEdit . dee))
+
+;; These are accessor functions for the widgets that make up the
+;; GnomeDEntryEdit widget.
+(gtk-import-function GtkWidget gnome_dentry_get_name_entry (GnomeDEntryEdit . dee))
+(gtk-import-function GtkWidget gnome_dentry_get_comment_entry (GnomeDEntryEdit . dee))
+(gtk-import-function GtkWidget gnome_dentry_get_exec_entry (GnomeDEntryEdit . dee))
+(gtk-import-function GtkWidget gnome_dentry_get_tryexec_entry (GnomeDEntryEdit . dee))
+(gtk-import-function GtkWidget gnome_dentry_get_doc_entry (GnomeDEntryEdit . dee))
+(gtk-import-function GtkWidget gnome_dentry_get_icon_entry (GnomeDEntryEdit . dee))
+
+\f
+;; The GtkWidget * return values were added in retrospect; sometimes
+;; you might want to connect to the "close" signal of the dialog, or
+;; something, the return value makes the functions more
+;; flexible. However, there is nothing especially guaranteed about
+;; these dialogs except that they will be dialogs, so don't count on
+;; anything.
+
+;; A little OK box
+(gtk-import-function GtkWidget gnome_ok_dialog (GtkString . message))
+(gtk-import-function GtkWidget gnome_ok_dialog_parented
+                    (GtkString . message)
+                    (GtkWindow . parent))
+
+;; Operation failed fatally. In an OK dialog.
+(gtk-import-function GtkWidget gnome_error_dialog '(GtkString . error))
+(gtk-import-function GtkWidget gnome_error_dialog_parented
+                    (GtkString . error)
+                    (GtkWindow . parent))
+
+;; Just a warning.
+(gtk-import-function GtkWidget gnome_warning_dialog '(GtkString . warning))
+(gtk-import-function GtkWidget gnome_warning_dialog_parented
+                    (GtkString . warning)
+                    (GtkWindow . parent))
+
+;;;/* Look in gnome-types.h for the callback types. */
+
+;;;/* Ask a yes or no question, and call the callback when it's answered. */
+;;;GtkWidget * gnome_question_dialog                 (const gchar * question,
+;;;                                               GnomeReplyCallback callback,
+;;;                                               gpointer data);
+
+;;;GtkWidget * gnome_question_dialog_parented        (const gchar * question,
+;;;                                               GnomeReplyCallback callback,
+;;;                                               gpointer data,
+;;;                                               GtkWindow * parent);
+
+;;;GtkWidget * gnome_question_dialog_modal           (const gchar * question,
+;;;                                               GnomeReplyCallback callback,
+;;;                                               gpointer data);
+
+;;;GtkWidget * gnome_question_dialog_modal_parented  (const gchar * question,
+;;;                                               GnomeReplyCallback callback,
+;;;                                               gpointer data,
+;;;                                               GtkWindow * parent);
+
+
+;;;/* OK-Cancel question. */
+;;;GtkWidget * gnome_ok_cancel_dialog                (const gchar * message,
+;;;                                               GnomeReplyCallback callback,
+;;;                                               gpointer data);
+
+;;;GtkWidget * gnome_ok_cancel_dialog_parented       (const gchar * message,
+;;;                                               GnomeReplyCallback callback,
+;;;                                               gpointer data,
+;;;                                               GtkWindow * parent);
+
+;;;GtkWidget * gnome_ok_cancel_dialog_modal          (const gchar * message,
+;;;                                               GnomeReplyCallback callback,
+;;;                                               gpointer data);
+
+;;;GtkWidget * gnome_ok_cancel_dialog_modal_parented (const gchar * message,
+;;;                                               GnomeReplyCallback callback,
+;;;                                               gpointer data,
+;;;                                               GtkWindow * parent);
+
+\f
+(gtk-import-function GtkType gnome_file_entry_get_type)
+(gtk-import-function GtkWidget gnome_file_entry_new
+                    (GtkString . history_id)
+                    (GtkString . browse_dialog_title))
+
+(gtk-import-function nil gnome_file_entry_construct
+                    (GnomeFileEntry . fentry)
+                    (GtkString . history_id)
+                    (GtkString . browse_dialog_title))
+
+(gtk-import-function GtkWidget gnome_file_entry_gnome_entry
+                    (GnomeFileEntry .fentry))
+
+(gtk-import-function GtkWidget gnome_file_entry_gtk_entry
+                    (GnomeFileEntry . fentry))
+
+(gtk-import-function nil gnome_file_entry_set_title
+                    (GnomeFileEntry . fentry)
+                    (GtkString      . browse_dialog_title))
+
+;; set default path for the browse dialog
+(gtk-import-function nil gnome_file_entry_set_default_path
+                    (GnomeFileEntry . fentry)
+                    (GtkString      . path))
+
+;; sets up the file entry to be a directory picker rather then a file picker
+(gtk-import-function nil gnome_file_entry_set_directory
+                    (GnomeFileEntry . fentry)
+                    (gboolean       . directory_entry))
+
+;; returns a filename which is a full path with WD or the default
+;; directory prepended if it's not an absolute path, returns
+;; NULL on empty entry or if the file doesn't exist and that was
+;; a requirement
+(gtk-import-function GtkString gnome_file_entry_get_full_path
+                    (GnomeFileEntry . fentry)
+                    (gboolean       . file_must_exist))
+
+;; set modality of the file browse dialog, only applies for the
+;; next time a dialog is created
+(gtk-import-function nil gnome_file_entry_set_modal
+                    (GnomeFileEntry . fentry)
+                    (gboolean       . is_modal))
+
+\f
+;; Standard Gtk function
+(gtk-import-function GtkType gnome_font_picker_get_type)
+
+;; Creates a new font picker widget
+(gtk-import-function GtkWidget gnome_font_picker_new)
+
+;; Sets the title for the font selection dialog
+(gtk-import-function nil gnome_font_picker_set_title
+                    (GnomeFontPicker . gfp)
+                    (GtkString       . title))
+
+;; Button mode
+(gtk-import-function GnomeFontPickerMode gnome_font_picker_get_mode
+                    (GnomeFontPicker . gfp))
+
+(gtk-import-function nil gnome_font_picker_set_mode
+                    (GnomeFontPicker . gfp)
+                    (GnomeFontPickerMode . mode))
+
+;; With  GNOME_FONT_PICKER_MODE_FONT_INFO
+;; If use_font_in_label is true, font name will be writen using font choosed by user and
+;; using size passed to this function
+(gtk-import-function nil gnome_font_picker_fi_set_use_font_in_label
+                    (GnomeFontPicker . gfp)
+                    (gboolean        . use_font_in_label)
+                    (gint            . size))
+
+(gtk-import-function nil gnome_font_picker_fi_set_show_size
+                    (GnomeFontPicker . gfp)
+                    (gboolean        . show_size))
+
+;; With GNOME_FONT_PICKER_MODE_USER_WIDGET
+(gtk-import-function nil gnome_font_picker_uw_set_widget
+                    (GnomeFontPicker . gfp)
+                    (GtkWidget       . widget))
+
+;; Functions to interface with GtkFontSelectionDialog
+(gtk-import-function GtkString gnome_font_picker_get_font_name
+                    (GnomeFontPicker . gfp))
+
+;;;GdkFont*   gnome_font_picker_get_font             (GnomeFontPicker *gfp);
+
+(gtk-import-function gboolean gnome_font_picker_set_font_name
+                    (GnomeFontPicker . gfp)
+                    (GtkString       . fontname))
+
+(gtk-import-function GtkString gnome_font_picker_get_preview_text
+                    (GnomeFontPicker . gfp))
+
+(gtk-import-function nil gnome_font_picker_set_preview_text
+                    (GnomeFontPicker . gfp)
+                    (GtkString       . text))
+
+\f
+(gtk-import-function GtkType gnome_href_get_type)
+(gtk-import-function GtkWidget gnome_href_new
+                    (GtkString . url)
+                    (GtkString . label))
+
+(gtk-import-function nil gnome_href_set_url
+                    (GnomeHRef . href)
+                    (GtkString . url))
+(gtk-import-function GtkString gnome_href_get_url
+                    (GnomeHRef . href))
+
+(gtk-import-function nil gnome_href_set_label
+                    (GnomeHRef . href)
+                    (GtkString . label))
+
+(gtk-import-function GtkString gnome_href_get_label
+                    (GnomeHRef . href))
+
+\f
+;; Stock icons, buttons, and menu items.
+
+;; A short description:
+
+;; These functions provide an applications programmer with default
+;; icons for toolbars, menu pixmaps, etc. One such `icon' should have
+;; at least three pixmaps to reflect it's state. There is a `regular'
+;; pixmap, a `disabled' pixmap and a `focused' pixmap. You can get
+;; either each of these pixmaps by calling gnome_stock_pixmap or you
+;; can get a widget by calling gnome_stock_pixmap_widget. This widget
+;; is a container which gtk_widget_shows the pixmap, that is
+;; reflecting the current state of the widget. If for example you
+;; gtk_container_add this widget to a button, which is currently not
+;; sensitive, the widget will just show the `disabled' pixmap. If the
+;; state of the button changes to sensitive, the widget will change to
+;; the `regular' pixmap. The `focused' pixmap will be shown, when the
+;; mouse pointer enters the widget.
+
+;; To support themability, we use (char *) to call those functions. A
+;; new theme might register new icons by calling
+;; gnome_stock_pixmap_register, or may change existing icons by
+;; calling gnome_stock_pixmap_change. An application should check (by
+;; calling gnome_stock_pixmap_checkfor), if the current theme supports
+;; an uncommon icon, before using it. The only icons an app can rely
+;; on, are those defined in this header file.
+
+;; We now have stock buttons too. To use them, just replace any
+;; gtk_button_new{_with_label} with
+;; gnome_stock_button(GNOME_STOCK_BUTTON_...).  This function returns
+;; a GtkButton with a gettexted default text and an icon.
+
+;; There's an additional feature, which might be interesting. If an
+;; application calls gnome_stock_pixmap_register and uses it by
+;; calling gnome_stock_pixmap_widget, it doesn't have to care about
+;; the state_changed signal to display the appropriate pixmap
+;; itself. Additionally gnome-stock generates a disabled version of a
+;; pixmap automatically, when no pixmap for a disabled state is
+;; provided.
+
+
+;; State:
+
+;;  currently implemented:
+;;    - gnome_stock_pixmap
+;;    - gnome_stock_pixmap_widget
+;;    - gnome_stock_pixmap_checkfor
+;;    - GnomeStockPixmapWidget
+;;    - gnome_stock_button
+;;    - gnome_stock_pixmap_register
+
+;;  not implemented:
+;;    - gnome_stock_pixmap_change
+
+;; The names of `well known' icons. I define these strings mainly to
+;; prevent errors due to typos.
+
+(defvar gnome-stock-pixmaps '(
+                             (new         . "New")
+                             (open        . "Open")
+                             (close       . "Close")
+                             (revert      . "Revert")
+                             (save        . "Save")
+                             (save-as     . "Save As")
+                             (cut         . "Cut")
+                             (copy        . "Copy")
+                             (paste       . "Paste")
+                             (clear       . "Clear")
+                             (properties  . "Properties")
+                             (preferences . "Preferences")
+                             (help        . "Help")
+                             (scores      . "Scores")
+                             (print       . "Print")
+                             (search      . "Search")
+                             (srchrpl     . "Search/Replace")
+                             (back        . "Back")
+                             (forward     . "Forward")
+                             (first       . "First")
+                             (last        . "Last")
+                             (home        . "Home")
+                             (stop        . "Stop")
+                             (refresh     . "Refresh")
+                             (undo        . "Undo")
+                             (redo        . "Redo")
+                             (timer       . "Timer")
+                             (timer-stop  . "Timer Stopped")
+                             (mail        . "Mail")
+                             (mail-rcv    . "Receive Mail")
+                             (mail-snd    . "Send Mail")
+                             (mail-rpl    . "Reply to Mail")
+                             (mail-fwd    . "Forward Mail")
+                             (mail-new    . "New Mail")
+                             (trash       . "Trash")
+                             (trash-full  . "Trash Full")
+                             (undelete    . "Undelete")
+                             (spellcheck  . "Spellchecker")
+                             (mic         . "Microphone")
+                             (line-in     . "Line In")
+                             (cdrom       . "Cdrom")
+                             (volume      . "Volume")
+                             (midi        . "Midi")
+                             (book-red    . "Book Red")
+                             (book-green  . "Book Green")
+                             (book-blue   . "Book Blue")
+                             (BOOK-YELLOW . "Book Yellow")
+                             (BOOK-OPEN   . "Book Open")
+                             (ABOUT       . "About")
+                             (QUIT        . "Quit")
+                             (MULTIPLE    . "Multiple")
+                             (NOT         . "Not")
+                             (CONVERT     . "Convert")
+                             (JUMP-TO     . "Jump To")
+                             (UP          . "Up")
+                             (DOWN        . "Down")
+                             (TOP         . "Top")
+                             (BOTTOM      . "Bottom")
+                             (ATTACH      . "Attach")
+                             (INDEX       . "Index")
+                             (FONT        . "Font")
+                             (EXEC        . "Exec")
+
+                             (ALIGN-LEFT    . "Left")
+                             (ALIGN-RIGHT   . "Right")
+                             (ALIGN-CENTER  . "Center")
+                             (ALIGN-JUSTIFY . "Justify")
+
+                             (TEXT-BOLD      . "Bold")
+                             (TEXT-ITALIC    . "Italic")
+                             (TEXT-UNDERLINE . "Underline")
+                             (TEXT-STRIKEOUT . "Strikeout")
+
+                             (TEXT-INDENT   . "Text Indent")
+                             (TEXT-UNINDENT . "Text Unindent")
+
+                             (EXIT          . "Quit")
+
+                             (COLORSELECTOR . "Color Select")
+
+                             (ADD    . "Add")
+                             (REMOVE . "Remove")
+
+                             (TABLE-BORDERS . "Table Borders")
+                             (TABLE-FILL    . "Table Fill")
+
+                             (TEXT-BULLETED-LIST . "Text Bulleted List")
+                             (TEXT-NUMBERED-LIST . "Text Numbered List")
+                             ))
+
+;; The basic pixmap version of an icon.
+
+;;#define GNOME_STOCK_PIXMAP_REGULAR     "regular"
+;;#define GNOME_STOCK_PIXMAP_DISABLED    "disabled"
+;;#define GNOME_STOCK_PIXMAP_FOCUSED     "focused"
+
+(defvar gnome-stock-pixmap-widget-new nil)
+
+(defun gnome-stock-pixmap-widget-new (window symbol)
+  "Load a stock pixmap named SYMBOL using WINDOW as the parent."
+  (if (not gnome-stock-pixmap-widget-new)
+      (setq gnome-stock-pixmap-widget-new (gtk-import-function-internal
+                                          'GtkWidget
+                                          "gnome_stock_pixmap_widget_new"
+                                          '(GtkWidget GtkString))))
+  (let ((translation (assq symbol gnome-stock-pixmaps)))
+    (if (not translation)
+       (error "Unknown stock pixmap: %S" symbol))
+    (gtk-call-function gnome-stock-pixmap-widget-new (list window (cdr translation)))))
+
+(gtk-import-function GtkType gnome_stock_get_type)
+(gtk-import-function GtkWidget gnome_stock_new)
+(gtk-import-function GtkWidget gnome_stock_new_with_icon '(GtkString . icon))
+(gtk-import-function gboolean gnome_stock_set_icon
+                    (GnomeStock . stock)
+                    (GtkString  . icon))
+
+;; just fetch a GnomeStock(PixmapWidget)
+;; It is possible to specify a filename instead of an icon name. Gnome stock
+;; will use gnome_pixmap_file to find the pixmap and return a GnomeStock widget
+;; from that file.
+(gtk-import-function GtkWidget gnome_stock_pixmap_widget
+                    (GtkWidget . window)
+                    (GtkString . icon))
+
+;; This function loads that file scaled to the specified size. Unlike
+;; gnome_pixmap_new_from_file_at_size this function uses antializing and stuff
+;; to scale the pixmap
+(gtk-import-function GtkWidget gnome_stock_pixmap_widget_at_size
+                    (GtkWidget . window)
+                    (GtkString . icon)
+                    (guint     . width)
+                    (guint     . height))
+
+(gtk-import-function nil gnome_stock_pixmap_widget_set_icon
+                    (GnomeStock . widget)
+                    (GtkString  . icon))
+
+;;;gint                   gnome_stock_pixmap_register (const char *icon,
+;;;                                                const char *subtype,
+;;;                                                    GnomeStockPixmapEntry *entry);
+
+;; change an existing entry. returns non-zero on success
+;;;gint                   gnome_stock_pixmap_change   (const char *icon,
+;;;                                                const char *subtype,
+;;;                                                    GnomeStockPixmapEntry *entry);
+
+;; check for the existance of an entry. returns the entry if it
+;; exists, or NULL otherwise
+;;;GnomeStockPixmapEntry *gnome_stock_pixmap_checkfor (const char *icon,
+;;;                                                const char *subtype);
+
+;; buttons
+
+(defvar gnome-stock-buttons '((ok     . "Button_Ok")
+                             (cancel . "Button_Cancel")
+                             (yes    . "Button_Yes")
+                             (no     . "Button_No")
+                             (close  . "Button_Close")
+                             (apply  . "Button_Apply")
+                             (help   . "Button_Help")
+                             (next   . "Button_Next")
+                             (prev   . "Button_Prev")
+                             (up     . "Button_Up")
+                             (down   . "Button_Down")
+                             (font   . "Button_Font")))
+
+;; this function returns a button with a pixmap (if ButtonUseIcons is enabled)
+;; and the provided text
+
+(gtk-import-function GtkWidget gnome_pixmap_button
+                    (GtkWidget . pixmap)
+                    (GtkString . text))
+(gtk-import-function nil gnome_button_can_default
+                    (GtkButton . button)
+                    (gboolean  . can_default))
+
+(defvar gnome-stock-button nil)
+
+(defun gnome-stock-button (symbol)
+  "Returns a default button widget for dialogs."
+  (if (not gnome-stock-button)
+      (setq gnome-stock-button (gtk-import-function-internal
+                               'GtkWidget "gnome_stock_button"
+                               '(GtkString))))
+  (let ((translation (assq symbol gnome-stock-buttons)))
+    (if (not translation)
+       (error "Unknown stock button: %S" symbol))
+    (gtk-call-function gnome-stock-button (list (cdr translation)))))
+
+(defun gnome-stock-or-ordinary-button (type)
+  "Returns a button widget.  If the TYPE argument matches a
+GNOME_STOCK_BUTTON_* define, then a stock button is created.
+Otherwise, an ordinary button is created, and TYPE is given as the
+label."
+  (if (stringp type) (setq type (intern type)))
+  (condition-case ()
+      (gnome-stock-button type)
+    (error (gtk-button-new-with-label (symbol-name type)))))
+
+;;/*  menus  */
+
+;;#define GNOME_STOCK_MENU_BLANK        "Menu_"
+;;#define GNOME_STOCK_MENU_NEW          "Menu_New"
+;;#define GNOME_STOCK_MENU_SAVE         "Menu_Save"
+;;#define GNOME_STOCK_MENU_SAVE_AS      "Menu_Save As"
+;;#define GNOME_STOCK_MENU_REVERT       "Menu_Revert"
+;;#define GNOME_STOCK_MENU_OPEN         "Menu_Open"
+;;#define GNOME_STOCK_MENU_CLOSE        "Menu_Close"
+;;#define GNOME_STOCK_MENU_QUIT         "Menu_Quit"
+;;#define GNOME_STOCK_MENU_CUT          "Menu_Cut"
+;;#define GNOME_STOCK_MENU_COPY         "Menu_Copy"
+;;#define GNOME_STOCK_MENU_PASTE        "Menu_Paste"
+;;#define GNOME_STOCK_MENU_PROP         "Menu_Properties"
+;;#define GNOME_STOCK_MENU_PREF         "Menu_Preferences"
+;;#define GNOME_STOCK_MENU_ABOUT        "Menu_About"
+;;#define GNOME_STOCK_MENU_SCORES       "Menu_Scores"
+;;#define GNOME_STOCK_MENU_UNDO         "Menu_Undo"
+;;#define GNOME_STOCK_MENU_REDO         "Menu_Redo"
+;;#define GNOME_STOCK_MENU_PRINT        "Menu_Print"
+;;#define GNOME_STOCK_MENU_SEARCH       "Menu_Search"
+;;#define GNOME_STOCK_MENU_SRCHRPL      "Menu_Search/Replace"
+;;#define GNOME_STOCK_MENU_BACK         "Menu_Back"
+;;#define GNOME_STOCK_MENU_FORWARD      "Menu_Forward"
+;;#define GNOME_STOCK_MENU_FIRST        "Menu_First"
+;;#define GNOME_STOCK_MENU_LAST         "Menu_Last"
+;;#define GNOME_STOCK_MENU_HOME         "Menu_Home"
+;;#define GNOME_STOCK_MENU_STOP         "Menu_Stop"
+;;#define GNOME_STOCK_MENU_REFRESH      "Menu_Refresh"
+;;#define GNOME_STOCK_MENU_MAIL         "Menu_Mail"
+;;#define GNOME_STOCK_MENU_MAIL_RCV     "Menu_Receive Mail"
+;;#define GNOME_STOCK_MENU_MAIL_SND     "Menu_Send Mail"
+;;#define GNOME_STOCK_MENU_MAIL_RPL     "Menu_Reply to Mail"
+;;#define GNOME_STOCK_MENU_MAIL_FWD     "Menu_Forward Mail"
+;;#define GNOME_STOCK_MENU_MAIL_NEW     "Menu_New Mail"
+;;#define GNOME_STOCK_MENU_TRASH        "Menu_Trash"
+;;#define GNOME_STOCK_MENU_TRASH_FULL   "Menu_Trash Full"
+;;#define GNOME_STOCK_MENU_UNDELETE     "Menu_Undelete"
+;;#define GNOME_STOCK_MENU_TIMER        "Menu_Timer"
+;;#define GNOME_STOCK_MENU_TIMER_STOP   "Menu_Timer Stopped"
+;;#define GNOME_STOCK_MENU_SPELLCHECK   "Menu_Spellchecker"
+;;#define GNOME_STOCK_MENU_MIC          "Menu_Microphone"
+;;#define GNOME_STOCK_MENU_LINE_IN      "Menu_Line In"
+;;#define GNOME_STOCK_MENU_CDROM            "Menu_Cdrom"
+;;#define GNOME_STOCK_MENU_VOLUME       "Menu_Volume"
+;;#define GNOME_STOCK_MENU_MIDI         "Menu_Midi"
+;;#define GNOME_STOCK_MENU_BOOK_RED     "Menu_Book Red"
+;;#define GNOME_STOCK_MENU_BOOK_GREEN   "Menu_Book Green"
+;;#define GNOME_STOCK_MENU_BOOK_BLUE    "Menu_Book Blue"
+;;#define GNOME_STOCK_MENU_BOOK_YELLOW  "Menu_Book Yellow"
+;;#define GNOME_STOCK_MENU_BOOK_OPEN    "Menu_Book Open"
+;;#define GNOME_STOCK_MENU_CONVERT      "Menu_Convert"
+;;#define GNOME_STOCK_MENU_JUMP_TO      "Menu_Jump To"
+;;#define GNOME_STOCK_MENU_UP           "Menu_Up"
+;;#define GNOME_STOCK_MENU_DOWN         "Menu_Down"
+;;#define GNOME_STOCK_MENU_TOP          "Menu_Top"
+;;#define GNOME_STOCK_MENU_BOTTOM       "Menu_Bottom"
+;;#define GNOME_STOCK_MENU_ATTACH       "Menu_Attach"
+;;#define GNOME_STOCK_MENU_INDEX        "Menu_Index"
+;;#define GNOME_STOCK_MENU_FONT         "Menu_Font"
+;;#define GNOME_STOCK_MENU_EXEC         "Menu_Exec"
+
+;;#define GNOME_STOCK_MENU_ALIGN_LEFT     "Menu_Left"
+;;#define GNOME_STOCK_MENU_ALIGN_RIGHT    "Menu_Right"
+;;#define GNOME_STOCK_MENU_ALIGN_CENTER   "Menu_Center"
+;;#define GNOME_STOCK_MENU_ALIGN_JUSTIFY  "Menu_Justify"
+
+;;#define GNOME_STOCK_MENU_TEXT_BOLD      "Menu_Bold"
+;;#define GNOME_STOCK_MENU_TEXT_ITALIC    "Menu_Italic"
+;;#define GNOME_STOCK_MENU_TEXT_UNDERLINE "Menu_Underline"
+;;#define GNOME_STOCK_MENU_TEXT_STRIKEOUT "Menu_Strikeout"
+
+;;#define GNOME_STOCK_MENU_EXIT     GNOME_STOCK_MENU_QUIT
+
+
+;;/* returns a GtkMenuItem with an stock icon and text */
+;;GtkWidget             *gnome_stock_menu_item       (const char *type,
+;;                                                 const char *text);
+
+
+;; Creates a toplevel window with a shaped mask.  Useful for making the DnD
+;; windows
+;; GtkWidget *gnome_stock_transparent_window (const char *icon, const char *subtype);
+
+;;;/*
+;;; * Return a GdkPixmap and GdkMask for a stock pixmap
+;;; */
+;;;void gnome_stock_pixmap_gdk (const char *icon,
+;;;                         const char *subtype,
+;;;                         GdkPixmap **pixmap,
+;;;                         GdkPixmap **mask);
+
+\f
+(gtk-import-function GtkType gnome_druid_get_type)
+(gtk-import-function GtkWidget gnome_druid_new)
+(gtk-import-function void gnome_druid_set_buttons_sensitive
+                    (GnomeDruid . druid)
+                    (gboolean   . back_sensitive)
+                    (gboolean   . next_sensitive)
+                    (gboolean   . cancel_sensitive))
+(gtk-import-function void gnome_druid_set_show_finish
+                    (GnomeDruid . druid)
+                    (gboolean   . show_finish))
+(gtk-import-function void gnome_druid_prepend_page
+                    (GnomeDruid . druid)
+                    (GnomeDruidPage . page))
+(gtk-import-function void gnome_druid_insert_page
+                    (GnomeDruid . druid)
+                    (GnomeDruidPage . back_page)
+                    (GnomeDruidPage . page))
+(gtk-import-function void gnome_druid_append_page
+                    (GnomeDruid . druid)
+                    (GnomeDruidPage . page))
+(gtk-import-function void gnome_druid_set_page
+                    (GnomeDruid . druid)
+                    (GnomeDruidPage . page))
+\f
+(gtk-import-function GtkType gnome_druid_page_get_type)
+(gtk-import-function gboolean gnome_druid_page_next (GnomeDruidPage . druid_page))
+(gtk-import-function gboolean gnome_druid_page_prepare (GnomeDruidPage . druid_page))
+(gtk-import-function gboolean gnome_druid_page_back (GnomeDruidPage . druid_page))
+(gtk-import-function gboolean gnome_druid_page_cancel (GnomeDruidPage . druid_page))
+(gtk-import-function gboolean gnome_druid_page_finish (GnomeDruidPage . druid_page))
+
+\f
+(gtk-import-function GtkType gnome_druid_page_start_get_type)
+(gtk-import-function GtkWidget gnome_druid_page_start_new)
+
+;; #### BOGUS!
+'(gtk-import-function GtkWidget gnome_druid_page_start_new_with_vals
+                    (GtkString . title)
+                    (GtkString . text)
+                    (GdkImlibImage . logo)
+                    (GdkImlibImage . watermark))
+
+(gtk-import-function void gnome_druid_page_start_set_bg_color
+                    (GnomeDruidPageStart . druid_page_start)
+                    (GdkColor . color))
+(gtk-import-function void gnome_druid_page_start_set_textbox_color
+                    (GnomeDruidPageStart . druid_page_start)
+                    (GdkColor . color))
+(gtk-import-function void gnome_druid_page_start_set_logo_bg_color
+                    (GnomeDruidPageStart . druid_page_start)
+                    (GdkColor . color))
+(gtk-import-function void gnome_druid_page_start_set_title_color
+                    (GnomeDruidPageStart . druid_page_start)
+                    (GdkColor . color))
+(gtk-import-function void gnome_druid_page_start_set_text_color
+                    (GnomeDruidPageStart . druid_page_start)
+                    (GdkColor . color))
+(gtk-import-function void gnome_druid_page_start_set_text
+                    (GnomeDruidPageStart . druid_page_start)
+                    (GtkString . text))
+(gtk-import-function void gnome_druid_page_start_set_title
+                    (GnomeDruidPageStart . druid_page_start)
+                    (GtkString . title))
+
+;; #### BOGUS!
+'(gtk-import-function void gnome_druid_page_start_set_logo
+                    (GnomeDruidPageStart . druid_page_start)
+                    (GdkImlibImage . logo_image))
+;; #### BOGUS!
+'(gtk-import-function void gnome_druid_page_start_set_watermark
+                    (GnomeDruidPageStart . druid_page_start)
+                    (GdkImlibImage . watermark))
+
+\f
+(gtk-import-function GtkType gnome_druid_page_standard_get_type)
+(gtk-import-function GtkWidget gnome_druid_page_standard_new)
+;; #### BOGUS!
+'(gtk-import-function GtkWidget gnome_druid_page_standard_new_with_vals
+                    (GtkString . title)
+                    (GdkImlibImage . logo))
+(gtk-import-function void gnome_druid_page_standard_set_bg_color
+                    (GnomeDruidPageStandard . druid_page_standard)
+                    (GdkColor . color))
+(gtk-import-function void gnome_druid_page_standard_set_logo_bg_color
+                    (GnomeDruidPageStandard . druid_page_standard)
+                    (GdkColor . color))
+(gtk-import-function void gnome_druid_page_standard_set_title_color
+                    (GnomeDruidPageStandard . druid_page_standard)
+                    (GdkColor . color))
+(gtk-import-function void gnome_druid_page_standard_set_title
+                    (GnomeDruidPageStandard . druid_page_standard)
+                    (GtkString . title))
+;; #### BOGUS!
+'(gtk-import-function void gnome_druid_page_standard_set_logo
+                    (GnomeDruidPageStandard . druid_page_standard)
+                    (GdkImlibImage . logo_image))
+
+\f
+(gtk-import-function GtkType   gnome_druid_page_finish_get_type)
+(gtk-import-function GtkWidget gnome_druid_page_finish_new)
+(gtk-import-function GtkWidget gnome_druid_page_finish_new_with_vals
+                    (GtkString . title)
+                    (GtkString . text)
+                    (GdkImlibImage . logo)
+                    (GdkImlibImage . watermark))
+
+(gtk-import-function void gnome_druid_page_finish_set_bg_color
+                    (GnomeDruidPageFinish . druid_page_finish)
+                    (GdkColor . color))
+(gtk-import-function void gnome_druid_page_finish_set_textbox_color
+                    (GnomeDruidPageFinish . druid_page_finish)
+                    (GdkColor . color))
+(gtk-import-function void gnome_druid_page_finish_set_logo_bg_color
+                    (GnomeDruidPageFinish . druid_page_finish)
+                    (GdkColor . color))
+(gtk-import-function void gnome_druid_page_finish_set_title_color
+                    (GnomeDruidPageFinish . druid_page_finish)
+                    (GdkColor . color))
+(gtk-import-function void gnome_druid_page_finish_set_text_color
+                    (GnomeDruidPageFinish . druid_page_finish)
+                    (GdkColor . color))
+(gtk-import-function void gnome_druid_page_finish_set_text
+                    (GnomeDruidPageFinish . druid_page_finish)
+                    (GtkString . text))
+(gtk-import-function void gnome_druid_page_finish_set_title
+                    (GnomeDruidPageFinish . druid_page_finish)
+                    (GtkString . title))
+;; #### BOGUS!
+'(gtk-import-function void gnome_druid_page_finish_set_logo
+                    (GnomeDruidPageFinish . druid_page_finish)
+                    (GdkImlibImage . logo_image))
+;; #### BOGUS!
+'(gtk-import-function void gnome_druid_page_finish_set_watermark
+                    (GnomeDruidPageFinish . druid_page_finish)
+                    (GdkImlibImage . watermark))
+
+(provide 'gnome-widgets)

diff --git a/lisp/gnome.el b/lisp/gnome.el
new file mode 100644 (file)
index 0000000..7cdb723
--- /dev/null
+++ b/lisp/gnome.el
@@ -0,0 +1,20 @@
+(defvar gnome-init-called nil)
+
+(defun gnome-init (app-id app-version argv)
+  (mapc 'dll-load
+       '("libgnomesupport.so"
+         "libgnome.so"
+         "libgnomeui.so"
+         "libesd.so"
+         "libaudiofile.so"
+         "libart_lgpl.so"))
+  (if (and (not (noninteractive)) (not gnome-init-called)
+          (= (gtk-type-from-name "GnomeApp") 0))      
+      (prog1
+         (gtk-call-function (gtk-import-function-internal
+                             'gint "gnome_init" '(GtkString GtkString gint GtkArrayOfString))
+                            (list app-id app-version (length argv) argv))
+       (setq gnome-init-called t))))
+
+(require 'gnome-widgets)
+(provide 'gnome)

diff --git a/lisp/gtk-compose.el b/lisp/gtk-compose.el
new file mode 100644 (file)
index 0000000..003169d
--- /dev/null
+++ b/lisp/gtk-compose.el
@@ -0,0 +1,4 @@
+(require 'gtk-iso8859-1)
+(require 'x-compose)
+
+(provide 'gtk-compose)

diff --git a/lisp/gtk-extra.el b/lisp/gtk-extra.el
new file mode 100644 (file)
index 0000000..10525fc
--- /dev/null
+++ b/lisp/gtk-extra.el
@@ -0,0 +1,117 @@
+;;; gtk-extra.el --- Import `GTK+ Extra' widgets into XEmacs
+
+;; Copyright (C) 2000 Free Software Foundation
+
+;; Maintainer: William Perry <wmperry@gnu.org>
+;; Keywords: extensions, 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, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+;; GTK+ Extra can be retrieved from http://magnet.fsu.edu/~feiguin/gtk
+
+(eval-and-compile
+  (require 'gtk-ffi))
+
+;;; gtkbordercombo.h
+(gtk-import-function GtkType gtk_border_combo_get_type)
+(gtk-import-function GtkWidget gtk_border_combo_new)
+
+;;; gtkcheckitem.h
+(gtk-import-function GtkType gtk_check_item_get_type)
+(gtk-import-function GtkWidget gtk_check_item_new)
+(gtk-import-function GtkWidget gtk_check_item_new_with_label
+                    (GtkString . label))
+
+;;; gtkcolorcombo.h
+(gtk-import-function GtkType gtk_color_combo_get_type)
+(gtk-import-function GtkWidget gtk_color_combo_new)
+(gtk-import-function GtkWidget gtk_color_combo_new_with_values
+                    (gint . nrows)
+                    (gint . ncols)
+                    (GtkArrayOfString . color_names))
+(gtk-import-function GtkString gtk_color_combo_get_color_at
+                    (GtkColorCombo . combo)
+                    (gint          . row)
+                    (gint          . col))
+;;;(gtk-import-function none gtk_color_combo_find_color
+;;;                 (GtkColorCombo . combo)
+;;;                 (GdkColor      . color)
+;;;                 ((gint . out)  . row)
+;;;                 ((gint . out)  . col))
+
+;;; gtkcombobox.h
+(gtk-import-function GtkType gtk_combobox_get_type)
+(gtk-import-function GtkWidget gtk_combobox_new)
+(gtk-import-function none gtk_combobox_hide_popdown_window)
+
+;;; gtkdirtree.h
+(gtk-import-function GtkType gtk_dir_tree_get_type)
+(gtk-import-function GtkWidget gtk_dir_tree_new)
+(gtk-import-function gint gtk_dir_tree_open_dir
+                    (GtkDirTree . tree)
+                    (GtkString  . path))
+
+;;; gtkfilelist.h
+(gtk-import-function GtkType gtk_file_list_get_type)
+(gtk-import-function GtkWidget gtk_file_list_new
+                    (guint . icon_width)
+                    (gint  . mode)
+                    (GtkString . path))
+(gtk-import-function none gtk_file_list_set_filter
+                    (GtkFileList . file_list)
+                    (GtkString   . filter))
+(gtk-import-function none gtk_file_list_open_dir
+                    (GtkFileList . file_list)
+                    (GtkString   . path))
+(gtk-import-function GtkString gtk_file_list_get_path
+                    (GtkFileList . file_list))
+(gtk-import-function GtkString gtk_file_list_get_filename
+                    (GtkFileList . file_list))
+
+;;; gtkfontcombo.h
+(gtk-import-function GtkType gtk_font_combo_get_type)
+(gtk-import-function GtkWidget gtk_font_combo_new)
+(gtk-import-function none gtk_font_combo_select
+                    (GtkFontCombo . font_combo)
+                    (GtkString    . family)
+                    (gboolean     . bold)
+                    (gboolean     . italic)
+                    (gint         . height))
+(gtk-import-function none gtk_font_combo_select_nth
+                    (GtkFontCombo . font_combo)
+                    (gint         . n)
+                    (gboolean     . bold)
+                    (gboolean     . italic)
+                    (gint         . height))
+
+;;; gtkiconfilesel.h
+;;; gtkiconlist.h
+;;; gtkitementry.h
+;;; gtkplot.h
+;;; gtkplotcanvas.h
+;;; gtkplotpc.h
+;;; gtkplotprint.h
+;;; gtkplotps.h
+;;; gtkpsfont.h
+;;; gtksheet.h
+
+(provide 'gtk-extra)

diff --git a/lisp/gtk-faces.el b/lisp/gtk-faces.el
new file mode 100644 (file)
index 0000000..3a6824c
--- /dev/null
+++ b/lisp/gtk-faces.el
@@ -0,0 +1,297 @@
+;;; gtk-faces.el --- GTK-specific face frobnication, aka black magic.
+
+;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996 Ben Wing.
+;; Copyright (c) 2000 William Perry
+
+;; Author: William M. Perry <wmperry@gnu.org>
+;; Maintainer: XEmacs Development Team
+;; 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Synched up with: Not synched.
+
+;;; Commentary:
+
+;; This file is dumped with XEmacs (when GTK support is compiled in).
+
+
+(defun gtk-init-find-device ()
+  (let ((dev nil)
+       (devices (device-list)))
+    (while (and (not dev) devices)
+      (if (eq (device-type (car devices)) 'gtk)
+         (setq dev (car devices)))
+      (setq devices (cdr devices)))
+    dev))
+
+;;; gtk-init-device-faces is responsible for initializing default
+;;; values for faces on a newly created device.
+;;;
+(defun gtk-init-device-faces (device)
+  ;;
+  ;; If the "default" face didn't have a font specified, try to pick one.
+  ;;
+  (if (not (eq (device-type device) 'gtk))
+      nil
+    (gtk-init-pointers)
+    '(let* ((style (gtk-style-info device))
+          ;;(normal 0)                 ; GTK_STATE_NORMAL
+          ;;(active 1)                 ; GTK_STATE_ACTIVE
+          (prelight 2)                 ; GTK_STATE_PRELIGHT
+          (selected 3)                 ; GTK_STATE_SELECTED
+          ;;(insensitive 4)            ; GTK_STATE_INSENSITIVE
+          )
+      (set-face-foreground 'highlight
+                          (nth prelight (plist-get style 'text))
+                          device)
+      (set-face-background 'highlight
+                          (nth prelight (plist-get style 'background))
+                          device)
+      (set-face-foreground 'zmacs-region
+                          (nth selected (plist-get style 'text))
+                          device)
+      (set-face-background 'zmacs-region
+                          (nth selected (plist-get style 'background))
+                          device))
+    (set-face-background 'text-cursor "red3" device)))
+
+;;; This is called from `init-frame-faces', which is called from
+;;; init_frame_faces() which is called from Fmake_frame(), to perform
+;;; any device-specific initialization.
+;;;
+(defun gtk-init-frame-faces (frame)
+  )
+
+;;; gtk-init-global-faces is responsible for ensuring that the
+;;; default face has some reasonable fallbacks if nothing else is
+;;; specified.
+;;;
+(defun gtk-init-global-faces ()
+  (let* ((dev (gtk-init-find-device))
+        (default-font (or (face-font 'default 'global)
+                          ;(plist-get (gtk-style-info dev) 'font)
+                          "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*"))
+        (italic-font (or (gtk-make-font-italic default-font dev) default-font))
+        (bold-font (or (gtk-make-font-bold default-font dev) default-font))
+        (bi-font (or (gtk-make-font-bold-italic default-font dev) default-font)))
+
+    (or (face-font 'default 'global)
+       (set-face-font 'default default-font 'global '(gtk default)))
+
+    (or (face-font 'bold 'global)
+       (set-face-font 'bold bold-font 'global '(gtk default)))
+
+    (or (face-font 'bold-italic 'global)
+       (set-face-font 'bold-italic bi-font 'global '(gtk default)))
+
+    (or (face-font 'italic 'global)
+       (set-face-font 'italic italic-font 'global '(gtk default)))))
+
+\f
+;;; Lots of this stolen from x-faces.el - I'm not sure if this will
+;;; require a rewrite for win32 or not?
+(defconst gtk-font-regexp nil)
+(defconst gtk-font-regexp-head nil)
+(defconst gtk-font-regexp-head-2 nil)
+(defconst gtk-font-regexp-weight nil)
+(defconst gtk-font-regexp-slant nil)
+(defconst gtk-font-regexp-pixel nil)
+(defconst gtk-font-regexp-point nil)
+(defconst gtk-font-regexp-foundry-and-family nil)
+(defconst gtk-font-regexp-registry-and-encoding nil)
+(defconst gtk-font-regexp-spacing nil)
+
+;;; Regexps matching font names in "Host Portable Character Representation."
+;;;
+(let ((-               "[-?]")
+      (foundry         "[^-]*")
+      (family          "[^-]*")
+      (weight          "\\(bold\\|demibold\\|medium\\|black\\)")       ; 1
+;     (weight\?                "\\(\\*\\|bold\\|demibold\\|medium\\|\\)")      ; 1
+      (weight\?                "\\([^-]*\\)")                                  ; 1
+      (slant           "\\([ior]\\)")                                  ; 2
+;     (slant\?         "\\([ior?*]?\\)")                               ; 2
+      (slant\?         "\\([^-]?\\)")                                  ; 2
+;     (swidth          "\\(\\*\\|normal\\|semicondensed\\|\\)")        ; 3
+      (swidth          "\\([^-]*\\)")                                  ; 3
+;     (adstyle         "\\(\\*\\|sans\\|\\)")                          ; 4
+      (adstyle         "\\([^-]*\\)")                                  ; 4
+      (pixelsize       "\\(\\*\\|[0-9]+\\)")                           ; 5
+      (pointsize       "\\(\\*\\|0\\|[0-9][0-9]+\\)")                  ; 6
+;      (resx           "\\(\\*\\|[0-9][0-9]+\\)")                      ; 7
+;      (resy           "\\(\\*\\|[0-9][0-9]+\\)")                      ; 8
+      (resx            "\\([*0]\\|[0-9][0-9]+\\)")                     ; 7
+      (resy            "\\([*0]\\|[0-9][0-9]+\\)")                     ; 8
+      (spacing         "[cmp?*]")
+      (avgwidth                "\\(\\*\\|[0-9]+\\)")                           ; 9
+      (registry                "[^-]*") ; some fonts have omitted registries
+;      (encoding       ".+")           ; note that encoding may contain "-"...
+      (encoding        "[^-]+")                ; false!
+      )
+  (setq gtk-font-regexp
+       (purecopy
+        (concat "\\`\\*?[-?*]"
+                foundry - family - weight\? - slant\? - swidth - adstyle -
+                pixelsize - pointsize - resx - resy - spacing - avgwidth -
+                registry - encoding "\\'"
+                )))
+  (setq gtk-font-regexp-head
+       (purecopy
+          (concat "\\`[-?*]" foundry - family - weight\? - slant\?
+                 "\\([-*?]\\|\\'\\)")))
+  (setq gtk-font-regexp-head-2
+       (purecopy
+          (concat "\\`[-?*]" foundry - family - weight\? - slant\?
+                 - swidth - adstyle - pixelsize - pointsize
+                 "\\([-*?]\\|\\'\\)")))
+  (setq gtk-font-regexp-slant (purecopy (concat - slant -)))
+  (setq gtk-font-regexp-weight (purecopy (concat - weight -)))
+  ;; if we can't match any of the more specific regexps (unfortunate) then
+  ;; look for digits; assume 2+ digits is 10ths of points, and 1-2 digits
+  ;; is pixels.  Bogus as hell.
+  (setq gtk-font-regexp-pixel (purecopy "[-?*]\\([0-9][0-9]?\\)[-?*]"))
+  (setq gtk-font-regexp-point (purecopy "[-?*]\\([0-9][0-9]+\\)[-?*]"))
+  ;; the following two are used by x-font-menu.el.
+  (setq gtk-font-regexp-foundry-and-family
+       (purecopy (concat "\\`[-?*]" foundry - "\\(" family "\\)" -)))
+  (setq gtk-font-regexp-registry-and-encoding
+       (purecopy (concat - "\\(" registry "\\)" - "\\(" encoding "\\)\\'")))
+  (setq gtk-font-regexp-spacing
+       (purecopy (concat - "\\(" spacing "\\)" - avgwidth
+                         - registry - encoding "\\'")))
+  )
+
+(defvaralias 'x-font-regexp 'gtk-font-regexp)
+(defvaralias 'x-font-regexp-head 'gtk-font-regexp-head)
+(defvaralias 'x-font-regexp-head-2 'gtk-font-regexp-head-2)
+(defvaralias 'x-font-regexp-weight 'gtk-font-regexp-weight)
+(defvaralias 'x-font-regexp-slant 'gtk-font-regexp-slant)
+(defvaralias 'x-font-regexp-pixel 'gtk-font-regexp-pixel)
+(defvaralias 'x-font-regexp-point 'gtk-font-regexp-point)
+(defvaralias 'x-font-regexp-foundry-and-family 'gtk-font-regexp-foundry-and-family)
+(defvaralias 'x-font-regexp-registry-and-encoding 'gtk-font-regexp-registry-and-encoding)
+(defvaralias 'x-font-regexp-spacing 'gtk-font-regexp-spacing)
+
+(defun gtk-frob-font-weight (font which)
+  (if (font-instance-p font) (setq font (font-instance-name font)))
+  (cond ((null font) nil)
+       ((or (string-match gtk-font-regexp font)
+            (string-match gtk-font-regexp-head font)
+            (string-match gtk-font-regexp-weight font))
+        (concat (substring font 0 (match-beginning 1)) which
+                (substring font (match-end 1))))
+       (t nil)))
+
+(defun gtk-frob-font-slant (font which)
+  (if (font-instance-p font) (setq font (font-instance-name font)))
+  (cond ((null font) nil)
+       ((or (string-match gtk-font-regexp font)
+            (string-match gtk-font-regexp-head font))
+        (concat (substring font 0 (match-beginning 2)) which
+                (substring font (match-end 2))))
+       ((string-match gtk-font-regexp-slant font)
+        (concat (substring font 0 (match-beginning 1)) which
+                (substring font (match-end 1))))
+       (t nil)))
+
+(defun gtk-make-font-bold (font &optional device)
+  (or (try-font-name (gtk-frob-font-weight font "bold") device)
+      (try-font-name (gtk-frob-font-weight font "black") device)
+      (try-font-name (gtk-frob-font-weight font "demibold") device)))
+
+(defun gtk-make-font-unbold (font &optional device)
+  (try-font-name (gtk-frob-font-weight font "medium") device))
+
+(defcustom *try-oblique-before-italic-fonts* t
+  "*If nil, italic fonts are searched before oblique fonts.
+If non-nil, oblique fonts are tried before italic fonts.  This is mostly
+applicable to adobe-courier fonts"
+  :type 'boolean
+  :tag "Try Oblique Before Italic Fonts"
+  :group 'x)
+
+(defun gtk-make-font-italic (font &optional device)
+  (if *try-oblique-before-italic-fonts*
+      (or (try-font-name (gtk-frob-font-slant font "o") device)
+         (try-font-name (gtk-frob-font-slant font "i") device))
+    (or (try-font-name (gtk-frob-font-slant font "i") device)
+       (try-font-name (gtk-frob-font-slant font "o") device))))
+
+(defun gtk-make-font-unitalic (font &optional device)
+  (try-font-name (gtk-frob-font-slant font "r") device))
+
+(defun gtk-make-font-bold-italic (font &optional device)
+  (if *try-oblique-before-italic-fonts*
+      (or (try-font-name
+          (gtk-frob-font-slant (gtk-frob-font-weight font "bold") "o") device)
+         (try-font-name
+          (gtk-frob-font-slant (gtk-frob-font-weight font "bold") "i") device)
+         (try-font-name
+          (gtk-frob-font-slant (gtk-frob-font-weight font "black") "o") device)
+         (try-font-name
+          (gtk-frob-font-slant (gtk-frob-font-weight font "black") "i") device)
+         (try-font-name
+          (gtk-frob-font-slant (gtk-frob-font-weight font "demibold") "o") device)
+         (try-font-name
+          (gtk-frob-font-slant (gtk-frob-font-weight font "demibold") "i") device))
+    (or (try-font-name
+        (gtk-frob-font-slant (gtk-frob-font-weight font "bold") "i") device)
+       (try-font-name
+        (gtk-frob-font-slant (gtk-frob-font-weight font "bold") "o") device)
+       (try-font-name
+        (gtk-frob-font-slant (gtk-frob-font-weight font "black") "i") device)
+       (try-font-name
+        (gtk-frob-font-slant (gtk-frob-font-weight font "black") "o") device)
+       (try-font-name
+        (gtk-frob-font-slant (gtk-frob-font-weight font "demibold") "i") device)
+       (try-font-name
+        (gtk-frob-font-slant (gtk-frob-font-weight font "demibold") "o") device))))
+
+(defun gtk-choose-font ()
+  (interactive)
+  (require 'x-font-menu)
+  (require 'font)
+  (let ((locale (if font-menu-this-frame-only-p
+                   (selected-frame)
+                 nil))
+       (dialog nil))
+    (setq dialog (gtk-font-selection-dialog-new "Choose default font..."))
+    (put dialog 'modal t)
+    (put dialog 'type 'dialog)
+
+    (gtk-widget-set-sensitive (gtk-font-selection-dialog-apply-button dialog) nil)
+    (gtk-signal-connect dialog 'destroy (lambda (&rest ignored) (gtk-main-quit)))
+    (gtk-signal-connect (gtk-font-selection-dialog-ok-button dialog)
+                       'clicked
+                       (lambda (button data)
+                         (let* ((dialog (car data))
+                                (locale (cdr data))
+                                (font (font-create-object
+                                       (gtk-font-selection-dialog-get-font-name dialog))))
+                           (gtk-widget-destroy dialog)
+                           (font-menu-set-font (car (font-family font)) nil (* 10 (font-size font)))))
+                       (cons dialog locale))
+    (gtk-signal-connect (gtk-font-selection-dialog-cancel-button dialog)
+                       'clicked
+                       (lambda (button dialog)
+                         (gtk-widget-destroy dialog)) dialog)
+
+    (gtk-widget-show-all dialog)
+    (gtk-main)))

diff --git a/lisp/gtk-ffi.el b/lisp/gtk-ffi.el
new file mode 100644 (file)
index 0000000..2d01f4b
--- /dev/null
+++ b/lisp/gtk-ffi.el
@@ -0,0 +1,104 @@
+;;; gtk-ffi.el --- Foreign function interface for the GTK object system
+
+;; Copyright (C) 2000 Free Software Foundation
+
+;; Maintainer: William Perry <wmperry@gnu.org>
+;; Keywords: extensions, 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, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+;; This file is dumped with XEmacs.
+
+(defvar gtk-type-aliases '((GtkType . guint)
+                          (GdkAtom . gulong)
+                          (GdkBitmap . GdkWindow)
+                          (time_t    . guint)
+                          (none      . void)
+                          (GdkDrawable . GdkWindow)
+                          (GdkBitmap . GdkWindow)
+                          (GdkPixmap . GdkWindow))
+  "An assoc list of aliases for commonly used GTK types that are not
+really part of the object system.")
+
+(defvar gtk-ffi-debug nil
+  "If non-nil, all functions defined wiht `gtk-import-function' will be checked
+for missing marshallers.")
+
+(defun gtk-ffi-check-function (func)
+  ;; We don't call gtk-main or gtk-main-quit because it thoroughly
+  ;; hoses us (locks up xemacs handling events, but no lisp).
+  (if (not (memq func '(gtk-main gtk-main-quit)))
+      (condition-case err
+         (funcall func)
+       (error
+        (case (car err)
+          (wrong-number-of-arguments nil)
+          (error
+           (if (string= "Could not locate marshaller function" (nth 1 err))
+               (progn
+                 (set-buffer (get-buffer-create "needed marshallers"))
+                 (display-buffer (current-buffer))
+                 (goto-char (point-max))
+                 (insert
+                  (format "%S\n"
+                          (split-string
+                           (substring (nth 2 err) (length "emacs_gtk_marshal_")) "_+")))))))))))
+
+(defmacro gtk-import-function (retval name &rest args)
+  (if (symbolp name)
+      (setq name (symbol-name name)))
+  (let ((lisp-name (intern (replace-in-string name "_" "-")))
+       (doc-string nil))
+    (setq retval (or (cdr-safe (assoc retval gtk-type-aliases)) retval)
+         doc-string (concat "The lisp version of " name ".\n"
+                            (if args
+                                (concat "Prototype: " (prin1-to-string args)))))
+
+    ;; Drop off any naming of arguments, etc.
+    (if (and args (consp (car args)))
+       (setq args (mapcar 'car args)))
+
+    ;; Get rid of any type aliases.
+    (setq args (mapcar (lambda (x)
+                        (or (cdr-safe (assoc x gtk-type-aliases)) x)) args))
+
+    `(progn
+       (defun ,lisp-name (&rest args)
+        ,doc-string
+        (if (not (get (quote ,lisp-name) 'gtk-ffi nil))
+            (put (quote ,lisp-name) 'gtk-ffi
+                 (gtk-import-function-internal (quote ,retval) ,name
+                                               (quote ,args))))
+        (gtk-call-function (get (quote ,lisp-name) 'gtk-ffi 'ignore) args))
+       (and gtk-ffi-debug (gtk-ffi-check-function (quote ,lisp-name))))))
+
+(defmacro gtk-import-variable (type name)
+  (if (symbolp name) (setq name (symbol-name name)))
+  (let ((lisp-name (intern (replace-in-string name "_" "-")))
+       (doc-string nil))
+    (setq type (or (cdr-safe (assoc type gtk-type-aliases)) type)
+         doc-string (concat "Retrieve the variable " name " (type: " (symbol-name type) ").\n"))
+    `(defun ,lisp-name ()
+       ,doc-string
+       (gtk-import-variable-internal (quote ,type) ,name))))
+
+(provide 'gtk-ffi)

diff --git a/lisp/gtk-file-dialog.el b/lisp/gtk-file-dialog.el
new file mode 100644 (file)
index 0000000..d844cf9
--- /dev/null
+++ b/lisp/gtk-file-dialog.el
@@ -0,0 +1,277 @@
+;;; gtk-file-dialog.el --- A nicer file selection dialog for XEmacs w/GTK primitives
+
+;; Copyright (C) 2000 Free Software Foundation, Inc.
+
+;; Maintainer: William M. Perry <wmperry@gnu.org>
+;; Keywords: extensions, internal
+
+;; 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:
+
+;; The default GTK file selection dialog is not sufficient for our
+;; needs.  Limitations include:
+;;
+;; - not derived from GtkDialog
+;; - no support for filters based on file types
+;; - no support for setting an initial directory
+;; - no way to tell it 'file must exist'
+;; - no easy way to tell it to look at directories only
+;; - ugly as sin
+;;
+;; This attempts to rectify the situation.
+
+(defun gtk-file-dialog-fill-file-list (dialog dir)
+  (if (not dir)
+      (setq dir (get dialog 'x-file-dialog-current-dir nil)))
+
+  (put dialog 'x-file-dialog-current-dir dir)
+
+  (let ((list (get dialog 'x-file-dialog-files-list nil))
+       (remotep (file-remote-p dir)))
+    (if (not list)
+       nil
+      (gtk-clist-clear list)
+      (gtk-clist-freeze list)
+      ;; NOTE: Current versions of efs / ange-ftp do not honor the
+      ;; files-only flag to directory-files, but actually DOING these
+      ;; checks is hideously expensive.  Leave it turned off for now.
+      (mapc (lambda (f)
+             (if (or t                 ; Lets just wait for EFS to
+                     (not remotep)     ; fix itself, shall we?
+                     (not (file-directory-p (expand-file-name f dir))))
+                 (gtk-clist-append list (list f))))
+           (directory-files dir nil
+                            (get dialog 'x-file-dialog-active-filter nil)
+                            nil t))
+      (gtk-clist-thaw list))))
+
+(defun gtk-file-dialog-fill-directory-list (dialog dir)
+  (let ((subdirs (directory-files dir nil nil nil 5))
+       (remotep (file-remote-p dir))
+       (selected-dir (get dialog 'x-file-dialog-current-dir "/"))
+       (directory-list (get dialog 'x-file-dialog-directory-list)))
+
+    (gtk-clist-freeze directory-list)
+    (gtk-clist-clear directory-list)
+
+    (while subdirs
+      (if (equal "." (car subdirs))
+         nil
+       ;; NOTE: Current versions of efs / ange-ftp do not honor the
+       ;; files-only flag to directory-files, but actually DOING these
+       ;; checks is hideously expensive.  Leave it turned off for now.
+       (if (or t                       ; Lets just wait for EFS to
+               (not remotep)           ; fix itself, shall we?
+               (file-directory-p (expand-file-name (car subdirs) dir)))
+           (gtk-clist-append directory-list (list (car subdirs)))))
+      (pop subdirs))
+    (gtk-clist-thaw directory-list)))
+
+(defun gtk-file-dialog-update-dropdown (dialog dir)
+  (let ((combo-box (get dialog 'x-file-dialog-select-list))
+       (components (reverse
+                    (delete ""
+                            (split-string dir
+                                          (concat "[" (char-to-string directory-sep-char) "]")))))
+       (entries nil))
+
+    (while components
+      (push (concat "/" (mapconcat 'identity (reverse components)
+                                  (char-to-string directory-sep-char)))
+           entries)
+      (pop components))
+    (push (expand-file-name "." "~/") entries)
+    (gtk-combo-set-popdown-strings combo-box (nreverse entries))))
+
+(defun gtk-file-dialog-select-directory (dialog dir)
+  (gtk-file-dialog-fill-directory-list dialog dir)
+  (gtk-file-dialog-fill-file-list dialog dir)
+  (gtk-file-dialog-update-dropdown dialog dir))
+
+(defun gtk-file-dialog-new (&rest keywords)
+  "Create a XEmacs file selection dialog.
+Optional keyword arguments allowed:
+
+:title                 The title of the dialog
+:initial-directory     Initial directory to show
+:filter-list           List of filter descriptions and filters
+:file-must-exist       Whether the file must exist or not
+:directory             Look for a directory instead
+:callback              Function to call with one arg, the selection
+"
+  (let* ((dialog (gtk-dialog-new))
+        (vbox (gtk-dialog-vbox dialog))
+        (dir (plist-get keywords :initial-directory default-directory))
+        (button-area (gtk-dialog-action-area dialog))
+        (initializing-gtk-file-dialog t)
+        (select-box nil)
+        button hbox)
+
+    (put dialog 'type 'dialog)
+
+    (gtk-window-set-title dialog (plist-get keywords :title "Select a file..."))
+
+    (setq button (gtk-button-new-with-label "OK"))
+    (gtk-container-add button-area button)
+    (gtk-signal-connect button 'clicked
+                       (lambda (button dialog)
+                         (funcall
+                          (get dialog 'x-file-dialog-callback 'ignore)
+                          (gtk-entry-get-text
+                           (get dialog 'x-file-dialog-entry nil)))
+                         (gtk-widget-destroy dialog))
+                       dialog)
+    (put dialog 'x-file-dialog-ok-button button)
+
+    (setq button (gtk-button-new-with-label "Cancel"))
+    (gtk-container-add button-area button)
+    (gtk-signal-connect button 'clicked
+                       (lambda (button dialog)
+                         (gtk-widget-destroy dialog)) dialog)
+
+    (put dialog 'x-file-dialog-cancel-button button)
+    (put dialog 'x-file-dialog-callback (plist-get keywords :callback 'ignore))
+    (put dialog 'x-file-dialog-construct-args keywords)
+    (put dialog 'x-file-dialog-current-dir dir)
+
+    ;; Dropdown list of directories...
+    (setq select-box (gtk-combo-new))
+    (gtk-combo-disable-activate select-box)
+    (gtk-box-pack-start vbox select-box nil nil 5)
+    (put dialog 'x-file-dialog-select-list select-box)
+
+    ;; Hitting return in the entry will change dirs...
+    (gtk-signal-connect (gtk-combo-entry select-box) 'activate
+                       (lambda (entry dialog)
+                         (gtk-file-dialog-select-directory dialog
+                                                           (gtk-entry-get-text entry)))
+                       dialog)
+
+    ;; Start laying out horizontally...
+    (setq hbox (gtk-hbox-new nil 0))
+    (gtk-box-pack-start vbox hbox t t 5)
+
+    ;; Directory listing
+    (let ((directories (gtk-clist-new-with-titles 1 '("Directories")))
+         (scrolled (gtk-scrolled-window-new nil nil))
+         (item nil))
+      (gtk-container-add scrolled directories)
+      (gtk-widget-set-usize scrolled 200 300)
+      (gtk-box-pack-start hbox scrolled t t 0)
+      (put dialog 'x-file-dialog-directory-list directories)
+      (put dialog 'x-file-dialog-directory-scrolled scrolled)
+
+      (gtk-signal-connect directories 'select-row
+                         (lambda (list row column event dialog)
+                           (let ((dir (expand-file-name
+                                        (gtk-clist-get-text
+                                         (get dialog 'x-file-dialog-directory-list)
+                                         row column)
+                                        (get dialog 'x-file-dialog-current-dir))))
+                             (if (and (misc-user-event-p event)
+                                      (event-function event))
+                                 (gtk-file-dialog-select-directory dialog dir)
+                               (gtk-entry-set-text
+                                (get dialog 'x-file-dialog-entry)
+                                dir))))
+                         dialog)
+      )
+
+    (if (plist-get keywords :directory nil)
+       ;; Directory listings only do not need the file or filters buttons.
+       nil
+      ;; File listing
+      (let ((list (gtk-clist-new-with-titles 1 '("Files")))
+           (scrolled (gtk-scrolled-window-new nil nil)))
+       (gtk-container-add scrolled list)
+       (gtk-widget-set-usize scrolled 200 300)
+       (gtk-box-pack-start hbox scrolled t t 0)
+
+       (gtk-signal-connect list 'select-row
+                           (lambda (list row column event dialog)
+                             (gtk-entry-set-text
+                              (get dialog 'x-file-dialog-entry nil)
+                              (expand-file-name
+                               (gtk-clist-get-text list row column)
+                               (get dialog 'x-file-dialog-current-dir nil)))
+                             (if (and (misc-user-event-p event)
+                                      (event-function event))
+                                 ;; Got a double or triple click event...
+                                 (gtk-button-clicked
+                                  (get dialog 'x-file-dialog-ok-button nil))))
+                           dialog)
+
+       (put dialog 'x-file-dialog-files-list list))
+
+      ;; Filters
+      (if (not (plist-get keywords :filter-list nil))
+         ;; Don't need to bother packing this
+         nil
+       (setq hbox (gtk-hbox-new nil 0))
+       (gtk-box-pack-start vbox hbox nil nil 0)
+
+       (let ((label nil)
+             (options (plist-get keywords :filter-list nil))
+             (omenu nil)
+             (menu nil)
+             (item nil))
+         (setq omenu (gtk-option-menu-new)
+               menu (gtk-menu-new)
+               label (gtk-label-new "Filter: "))
+
+         (put dialog 'x-file-dialog-active-filter (cdr (car options)))
+         (mapc (lambda (o)
+                 (setq item (gtk-menu-item-new-with-label (car o)))
+                 (gtk-signal-connect item 'activate
+                                     (lambda (obj data)
+                                       (put (car data) 'x-file-dialog-active-filter (cdr data))
+                                       (gtk-file-dialog-fill-file-list (car data) nil))
+                                     (cons dialog (cdr o)))
+                 (gtk-menu-append menu item)
+                 (gtk-widget-show item)) options)
+         (gtk-option-menu-set-menu omenu menu)
+         (gtk-box-pack-end hbox omenu nil nil 0)
+         (gtk-box-pack-end hbox label nil nil 0))))
+
+      ;; Entry
+    (let ((entry (gtk-entry-new)))
+      (if (plist-get keywords :directory nil)
+         nil
+       (gtk-box-pack-start vbox entry nil nil 0))
+      (if (plist-get keywords :file-must-exist nil)
+         (progn
+           (gtk-widget-set-sensitive (get dialog 'x-file-dialog-ok-button nil) nil)
+           (gtk-signal-connect entry 'changed
+                               (lambda (entry dialog)
+                                 (gtk-widget-set-sensitive
+                                  (get dialog 'x-file-dialog-ok-button)
+                                  (file-exists-p (gtk-entry-get-text entry))))
+                               dialog)))
+      (put dialog 'x-file-dialog-entry entry))
+
+    (gtk-widget-realize dialog)
+
+
+    ;; Populate the file list if necessary
+    (gtk-file-dialog-select-directory dialog dir)
+    dialog))
+
+(provide 'gtk-file-dialog)

diff --git a/lisp/gtk-font-menu.el b/lisp/gtk-font-menu.el
new file mode 100644 (file)
index 0000000..3d15e1e
--- /dev/null
+++ b/lisp/gtk-font-menu.el
@@ -0,0 +1,248 @@
+;; gtk-font-menu.el --- Managing menus of GTK fonts.
+
+;; Copyright (C) 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
+;; Copyright (C) 1997 Sun Microsystems
+
+;; Author: Jamie Zawinski <jwz@jwz.org>
+;; Restructured by: Jonathan Stigelman <Stig@hackvan.com>
+;; Mule-ized by: Martin Buchholz
+;; More restructuring for MS-Windows by Andy Piper <andy@xemacs.org>
+;; GTK-ized by: William Perry <wmperry@xemacs.org>
+
+;; 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.
+;;; Code:
+
+;; #### - implement these...
+;;
+;;; (defvar font-menu-ignore-proportional-fonts nil
+;;;   "*If non-nil, then the font menu will only show fixed-width fonts.")
+
+(require 'font-menu)
+
+(defvar gtk-font-menu-registry-encoding nil
+  "Registry and encoding to use with font menu fonts.")
+
+(defvar gtk-fonts-menu-junk-families
+  (mapconcat
+   #'identity
+   '("cursor" "glyph" "symbol" ; Obvious losers.
+     "\\`Ax...\\'"             ; FrameMaker fonts - there are just way too
+                               ;  many of these, and there is a different
+                               ;  font family for each font face!  Losers.
+                               ;  "Axcor" -> "Applix Courier Roman",
+                               ;  "Axcob" -> "Applix Courier Bold", etc.
+     )
+   "\\|")
+  "A regexp matching font families which are uninteresting (e.g. cursor fonts).")
+
+(defun hack-font-truename (fn)
+  "Filter the output of `font-instance-truename' to deal with Japanese fontsets."
+  (if (string-match "," (font-instance-truename fn))
+      (let ((fpnt (nth 8 (split-string (font-instance-name fn) "-")))
+           (flist (split-string (font-instance-truename fn) ","))
+           ret)
+       (while flist
+         (if (string-equal fpnt (nth 8 (split-string (car flist) "-")))
+             (progn (setq ret (car flist)) (setq flist nil))
+           (setq flist (cdr flist))
+           ))
+       ret)
+    (font-instance-truename fn)))
+
+(defvar gtk-font-regexp-ascii nil
+  "This is used to filter out font families that can't display ASCII text.
+It must be set at run-time.")
+
+;;;###autoload
+(defun gtk-reset-device-font-menus (device &optional debug)
+  "Generates the `Font', `Size', and `Weight' submenus for the Options menu.
+This is run the first time that a font-menu is needed for each device.
+If you don't like the lazy invocation of this function, you can add it to
+`create-device-hook' and that will make the font menus respond more quickly
+when they are selected for the first time.  If you add fonts to your system, 
+or if you change your font path, you can call this to re-initialize the menus."
+  ;; by Stig@hackvan.com
+  ;; #### - this should implement a `menus-only' option, which would
+  ;; recalculate the menus from the cache w/o having to do list-fonts again.
+  (unless gtk-font-regexp-ascii
+    (setq gtk-font-regexp-ascii (if (featurep 'mule)
+                                   (charset-registry 'ascii)
+                                 "iso8859-1")))
+  (setq gtk-font-menu-registry-encoding
+       (if (featurep 'mule) "*-*" "iso8859-1"))
+  (let ((case-fold-search t)
+       family size weight entry monospaced-p
+       dev-cache cache families sizes weights)
+    (dolist (name (cond ((null debug)  ; debugging kludge
+                        (list-fonts "*-*-*-*-*-*-*-*-*-*-*-*-*-*" device))
+                       ((stringp debug) (split-string debug "\n"))
+                       (t debug)))
+      (when (and (string-match gtk-font-regexp-ascii name)
+                (string-match gtk-font-regexp name))
+       (setq weight (capitalize (match-string 1 name))
+             size   (string-to-int (match-string 6 name)))
+       (or (string-match gtk-font-regexp-foundry-and-family name)
+           (error "internal error"))
+       (setq family (capitalize (match-string 1 name)))
+       (or (string-match gtk-font-regexp-spacing name)
+           (error "internal error"))
+       (setq monospaced-p (string= "m" (match-string 1 name)))
+       (unless (string-match gtk-fonts-menu-junk-families family)
+         (setq entry (or (vassoc family cache)
+                         (car (setq cache
+                                    (cons (vector family nil nil t)
+                                          cache)))))
+         (or (member family families) (push family families))
+         (or (member weight weights)  (push weight weights))
+         (or (member size   sizes)    (push size   sizes))
+         (or (member weight (aref entry 1)) (push weight (aref entry 1)))
+         (or (member size   (aref entry 2)) (push size   (aref entry 2)))
+         (aset entry 3 (and (aref entry 3) monospaced-p)))))
+    ;;
+    ;; Hack scalable fonts.
+    ;; Some fonts come only in scalable versions (the only size is 0)
+    ;; and some fonts come in both scalable and non-scalable versions
+    ;; (one size is 0).  If there are any scalable fonts at all, make
+    ;; sure that the union of all point sizes contains at least some
+    ;; common sizes - it's possible that some sensible sizes might end
+    ;; up not getting mentioned explicitly.
+    ;;
+    (if (member 0 sizes)
+       (let ((common '(60 80 100 120 140 160 180 240)))
+         (while common
+           (or;;(member (car common) sizes)   ; not enough slack
+            (let ((rest sizes)
+                  (done nil))
+              (while (and (not done) rest)
+                (if (and (> (car common) (- (car rest) 5))
+                         (< (car common) (+ (car rest) 5)))
+                    (setq done t))
+                (setq rest (cdr rest)))
+              done)
+            (setq sizes (cons (car common) sizes)))
+           (setq common (cdr common)))
+         (setq sizes (delq 0 sizes))))
+    
+    (setq families (sort families 'string-lessp)
+         weights  (sort weights 'string-lessp)
+         sizes    (sort sizes '<))
+    
+    (dolist (entry cache)
+      (aset entry 1 (sort (aref entry 1) 'string-lessp))
+      (aset entry 2 (sort (aref entry 2) '<)))
+
+    (setq dev-cache (assq device device-fonts-cache))
+    (or dev-cache
+       (setq dev-cache (car (push (list device) device-fonts-cache))))
+    (setcdr
+     dev-cache
+     (vector
+      cache
+      (mapcar (lambda (x)
+               (vector x
+                       (list 'font-menu-set-font x nil nil)
+                       ':style 'radio ':active nil ':selected nil))
+             families)
+      (mapcar (lambda (x)
+               (vector (if (/= 0 (% x 10))
+                           ;; works with no LISP_FLOAT_TYPE
+                           (concat (int-to-string (/ x 10)) "."
+                                   (int-to-string (% x 10)))
+                         (int-to-string (/ x 10)))
+                       (list 'font-menu-set-font nil nil x)
+                       ':style 'radio ':active nil ':selected nil))
+             sizes)
+      (mapcar (lambda (x)
+               (vector x
+                       (list 'font-menu-set-font nil x nil)
+                       ':style 'radio ':active nil ':selected nil))
+             weights)))
+    (cdr dev-cache)))
+
+;; Extract font information from a face.  We examine both the
+;; user-specified font name and the canonical (`true') font name.
+;; These can appear to have totally different properties.
+;; For examples, see the prolog above.
+
+;; We use the user-specified one if possible, else use the truename.
+;; If the user didn't specify one (with "-dt-*-*", for example)
+;; get the truename and use the possibly suboptimal data from that.
+;;;###autoload
+(defun* gtk-font-menu-font-data (face dcache)
+  (defvar gtk-font-regexp)
+  (defvar gtk-font-regexp-foundry-and-family)
+  (let* ((case-fold-search t)
+        (domain (if font-menu-this-frame-only-p
+                                 (selected-frame)
+                               (selected-device)))
+        (name (font-instance-name (face-font-instance face domain)))
+        (truename (font-instance-truename
+                   (face-font-instance face domain
+                                       (if (featurep 'mule) 'ascii))))
+        family size weight entry slant)
+    (when (string-match gtk-font-regexp-foundry-and-family name)
+      (setq family (capitalize (match-string 1 name)))
+      (setq entry (vassoc family (aref dcache 0))))
+    (when (and (null entry)
+              (string-match gtk-font-regexp-foundry-and-family truename))
+      (setq family (capitalize (match-string 1 truename)))
+      (setq entry  (vassoc family (aref dcache 0))))
+    (when (null entry)
+      (return-from gtk-font-menu-font-data (make-vector 5 nil)))
+    
+    (when (string-match gtk-font-regexp name)
+      (setq weight (capitalize    (match-string 1 name)))
+      (setq size   (string-to-int (match-string 6 name))))
+      
+    (when (string-match gtk-font-regexp truename)
+      (when (not (member weight (aref entry 1)))
+       (setq weight (capitalize (match-string 1 truename))))
+      (when (not (member size   (aref entry 2)))
+       (setq size (string-to-int (match-string 6 truename))))
+      (setq slant (capitalize (match-string 2 truename))))
+      
+    (vector entry family size weight slant)))
+
+(defun gtk-font-menu-load-font (family weight size slant resolution)
+  "Try to load a font with the requested properties.
+The weight, slant and resolution are only hints."
+  (when (integerp size) (setq size (int-to-string size)))
+  (let (font)
+    (catch 'got-font
+      (dolist (weight (list weight "*"))
+       (dolist (slant
+                (cond ((string-equal slant "O") '("O" "I" "*"))
+                      ((string-equal slant "I") '("I" "O" "*"))
+                      ((string-equal slant "*") '("*"))
+                      (t (list slant "*"))))
+         (dolist (resolution
+                  (if (string-equal resolution "*-*")
+                      (list resolution)
+                    (list resolution "*-*")))
+           (when (setq font
+                       (make-font-instance
+                        (concat  "-*-" family "-" weight "-" slant "-*-*-*-"
+                                 size "-" resolution "-*-*-"
+                                 gtk-font-menu-registry-encoding)
+                        nil t))
+             (throw 'got-font font))))))))
+
+(provide 'gtk-font-menu)
+
+;;; gtk-font-menu.el ends here

diff --git a/lisp/gtk-glyphs.el b/lisp/gtk-glyphs.el
new file mode 100644 (file)
index 0000000..cc9c501
--- /dev/null
+++ b/lisp/gtk-glyphs.el
@@ -0,0 +1,76 @@
+;;; gtk-glyphs.el --- Support for glyphs in Gtk
+
+;; Copyright (C) 1994, 1997 Free Software Foundation, Inc.
+
+;; Author: Kirill M. Katsnelson <kkm@kis.ru>
+;; Maintainer: XEmacs Development Team
+;; 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 contains temporary definitions for 'gtk glyphs.
+;; Since there currently is no image support, the glyps are defined
+;; TTY-style. This file has to be removed or reworked completely
+;; when we have images.
+
+;; This file is dumped with XEmacs.
+
+;;; Code:
+
+(progn
+  (if (featurep 'gtk)
+      (set-console-type-image-conversion-list
+       'gtk
+       `(,@(if (featurep 'xpm) '(("\\.xpm\\'" [xpm :file nil] 2)))
+          ("\\.xbm\\'" [xbm :file nil] 2)
+          ,@(if (featurep 'xpm) '(("\\`/\\* XPM \\*/" [xpm :data nil] 2)))
+          ,@(if (featurep 'xface) '(("\\`X-Face:" [xface :data nil] 2)))
+          ,@(if (featurep 'gif) '(("\\.gif\\'" [gif :file nil] 2)
+                                  ("\\`GIF8[79]" [gif :data nil] 2)))
+          ,@(if (featurep 'jpeg) '(("\\.jpe?g\\'" [jpeg :file nil] 2)))
+          ;; all of the JFIF-format JPEG's that I've seen begin with
+          ;; the following.  I have no idea if this is standard.
+          ,@(if (featurep 'jpeg) '(("\\`\377\330\377\340\000\020JFIF"
+                                    [jpeg :data nil] 2)))
+          ,@(if (featurep 'png) '(("\\.png\\'" [png :file nil] 2)))
+          ,@(if (featurep 'png) '(("\\`\211PNG" [png :data nil] 2)))
+          ("" [autodetect :data nil] 2))))
+  (cond ((featurep 'xpm)
+        (set-glyph-image frame-icon-glyph
+                         (concat "../etc/" "xemacs-icon3.xpm")
+                         'global 'gtk)
+        (set-glyph-image xemacs-logo
+                         (concat "../etc/"
+                                 (if emacs-beta-version
+                                     "xemacs-beta.xpm"
+                                   "xemacs.xpm"))
+                         'global 'gtk))
+       (t
+        (set-glyph-image xemacs-logo
+                         "XEmacs <insert spiffy graphic logo here>"
+                         'global 'gtk)))
+  (set-glyph-image octal-escape-glyph "\\")
+  (set-glyph-image control-arrow-glyph "^")
+  (set-glyph-image invisible-text-glyph " ...")
+  )
+
+;;; gtk-glyphs.el ends here

diff --git a/lisp/gtk-init.el b/lisp/gtk-init.el
new file mode 100644 (file)
index 0000000..9fc1dea
--- /dev/null
+++ b/lisp/gtk-init.el
@@ -0,0 +1,332 @@
+;;; gtk-init.el --- initialization code for mswindows
+;; Copyright (C) 1990, 1993, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1995 Board of Trustees, University of Illinois.
+;; Copyright (C) 1995, 1996 Ben Wing.
+
+;; Author: various
+;; Rewritten for Gtk by: William Perry
+
+;; 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.
+
+(defvar gtk-win-initted nil)
+(defvar gtk-pre-win-initted nil)
+(defvar gtk-post-win-initted nil)
+
+(defvar gtk-command-switch-alist
+  '(
+    ;; GNOME Options
+    ("--disable-sound" . nil)
+    ("--enable-sound"  . nil)
+    ("--espeaker"      . t)
+
+    ;; GTK Options
+    ("--gdk-debug"    . t)
+    ("--gdk-no-debug" . t)
+    ("--display"      . t)
+    ("--sync"         . nil)
+    ("--no-xshm"      . nil)
+    ("--name"         . t)
+    ("--class"        . t)
+    ("--gxid_host"    . t)
+    ("--gxid_port"    . t)
+    ("--xim-preedit"  . t)
+    ("--xim-status"   . t)
+    ("--gtk-debug"    . t)
+    ("--gtk-no-debug" . t)
+    ("--gtk-module"   . t)
+
+    ;; Glib options
+    ("--g-fatal-warnings" . nil)
+
+    ;; Session management options
+    ("--sm-client-id"     . t)
+    ("--sm-config-prefix" . t)
+    ("--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.
+
+The CDR of the assoc list is whether it accepts an argument.  All options are in
+GNU long form though.")
+
+(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 gtk-init-handle-geometry (arg)
+  "Set up initial geometry info for GTK devices."
+  (setq gtk-initial-geometry (pop command-line-args-left)))
+
+(defun gtk-filter-arguments ()
+  (let ((accepted nil)
+       (rejected nil)
+       (todo nil))
+    (setq todo (mapcar (lambda (argdesc)
+                        (if (cdr argdesc)
+                            ;; Need to look for --foo=bar
+                            (concat "^" (car argdesc) "=")
+                          ;; Just a simple arg
+                          (concat "^" (regexp-quote (car argdesc)) "$")))
+                      gtk-command-switch-alist))
+
+    (while command-line-args-left
+      (if (catch 'found
+           (mapc (lambda (r)
+                   (if (string-match r (car command-line-args-left))
+                       (throw 'found t))) todo)
+           (mapc (lambda (argdesc)
+                   (if (cdr argdesc)
+                       ;; This time we only care about argument items
+                       ;; that take an argument.  We'll check to see if
+                       ;; someone used --foo bar instead of --foo=bar
+                       (if (string-match (concat "^" (car argdesc) "$") (car command-line-args-left))
+                           ;; Yup!  Need to push
+                           (progn
+                             (push (pop command-line-args-left) accepted)
+                             (throw 'found t)))))
+                 gtk-command-switch-alist)
+           nil)
+         (push (pop command-line-args-left) accepted)
+       (push (pop command-line-args-left) rejected)))
+    (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
+    (if (and (not (featurep 'infodock)) (featurep 'toolbar))
+        (init-x-toolbar))
+    (if (and (featurep 'infodock) (featurep 'toolbar))
+       (require 'id-x-toolbar))
+
+    (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))
+    
+    (add-hook 'zmacs-deactivate-region-hook
+             (lambda ()
+               (if (console-on-window-system-p)
+                   (disown-selection))))
+    (add-hook 'zmacs-activate-region-hook
+             (lambda ()
+               (if (console-on-window-system-p)
+                   (activate-region-as-selection))))
+    (add-hook 'zmacs-update-region-hook
+             (lambda ()
+               (if (console-on-window-system-p)
+                   (activate-region-as-selection))))
+
+    (define-key global-map 'menu 'popup-mode-menu)
+    (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)
+       (define-key function-key-map [,key] ',map))))
+
+(defun gtk-initialize-compose ()
+  "Enable compose processing"
+  (autoload 'compose-map           "gtk-compose" nil t 'keymap)
+  (autoload 'compose-acute-map     "gtk-compose" nil t 'keymap)
+  (autoload 'compose-grave-map     "gtk-compose" nil t 'keymap)
+  (autoload 'compose-cedilla-map    "gtk-compose" nil t 'keymap)
+  (autoload 'compose-diaeresis-map  "gtk-compose" nil t 'keymap)
+  (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)
+    (define-key function-key-map [multi-key] 'compose-map))
+
+  ;; The dead keys might really be called just about anything, depending
+  ;; on the vendor.  MIT thinks that the prefixes are "SunFA_", "D", and
+  ;; "hpmute_" for Sun, DEC, and HP respectively.  However, OpenWindows 3
+  ;; thinks that the prefixes are "SunXK_FA_", "DXK_", and "hpXK_mute_".
+  ;; And HP (who don't mention Sun and DEC at all) use "XK_mute_".
+  ;; Go figure.
+
+  ;; Presumably if someone is running OpenWindows, they won't be using
+  ;; the DEC or HP keysyms, but if they are defined then that is possible,
+  ;; so in that case we accept them all.
+
+  ;; If things seem not to be working, you might want to check your
+  ;; /usr/lib/X11/XKeysymDB file to see if your vendor has an equally
+  ;; 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)
+
+  ;; 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)
+
+  ;; 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)
+
+  ;; 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)
+
+  ;; 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)
+
+  ;; 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)
+
+  ;; 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)
+
+  ;; 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)
+
+  ;; 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)
+
+  ;; 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)
+
+  ;; 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)
+  )
+
+(when (featurep 'gtk)
+  (add-hook
+   'create-console-hook
+   (lambda (console)
+     (letf (((selected-console) console))
+       (when (eq 'gtk (console-type console))
+        (gtk-initialize-compose))))))

diff --git a/lisp/gtk-iso8859-1.el b/lisp/gtk-iso8859-1.el
new file mode 100644 (file)
index 0000000..4e3190b
--- /dev/null
+++ b/lisp/gtk-iso8859-1.el
@@ -0,0 +1,5 @@
+;; We can just cheat and use the same code that X does.
+
+(setq character-set-property 'x-iso8859/1) ; see x-iso8859-1.el
+(require 'x-iso8859-1)
+(provide 'gtk-iso8859-1)

diff --git a/lisp/gtk-marshal.el b/lisp/gtk-marshal.el
new file mode 100644 (file)
index 0000000..2a1a81e
--- /dev/null
+++ b/lisp/gtk-marshal.el
@@ -0,0 +1,289 @@
+(defconst name-to-return-type
+  '(("INT" . "guint")
+    ("CALLBACK" . "GtkCallback")
+    ("OBJECT" . "GtkObject *")
+    ("POINTER" . "void *")
+    ("STRING" . "gchar *")
+    ("BOOL" . "gboolean")
+    ("DOUBLE" . "gdouble")
+    ("FLOAT" . "gfloat")
+    ("LIST"  . "void *")
+    ("NONE" . nil)))
+
+(defvar defined-marshallers nil)
+
+(defun get-marshaller-name (rval args)
+  (concat "emacs_gtk_marshal_" rval "__"
+         (mapconcat 'identity (or args '("NONE")) "_")))
+
+(defun define-marshaller (rval &rest args)
+  (let ((name nil)
+       (internal-rval (assoc rval  name-to-return-type))
+       (ctr 0)
+       (func-proto (format "__%s_fn" rval)))
+    (if (not internal-rval)
+       (error "Do not know return type of `%s'" rval))
+    (setq name (get-marshaller-name rval args))
+
+    (if (member name defined-marshallers)
+       (error "Attempe to define the same marshaller more than once! %s" name))
+
+    (set-buffer (get-buffer-create "emacs-marshals.c"))
+    (goto-char (point-max))
+
+    (if (or (member "FLOAT" args) (member "DOUBLE" args))
+       ;; We need to special case anything with FLOAT in the argument
+       ;; list or the parameters get screwed up royally.
+       (progn
+         (setq func-proto (concat (format "__%s__" rval)
+                                  (mapconcat 'identity args "_")
+                                  "_fn"))
+         (insert "typedef "
+                 (or (cdr internal-rval) "void")
+                 " (*"
+                 func-proto ")("
+                 (mapconcat (lambda (x)
+                              (cdr (assoc x name-to-return-type))) args ", ")
+                 ");\n")))
+
+    (insert "\n"
+           "static void\n"
+           name " (ffi_actual_function func, GtkArg *args)\n"
+           "{\n"
+           (format "  %s rfunc = (%s) func;\n" func-proto func-proto))
+
+    (if (string= "LIST" rval) (setq rval "POINTER"))
+
+    (if (cdr internal-rval)
+       ;; It has a return type to worry about
+       (insert "  " (cdr internal-rval) " *return_val;\n\n"
+               (format "  return_val = GTK_RETLOC_%s (args[%d]);\n" rval (length args))
+               "  *return_val = ")
+      (insert "  "))
+    (insert "(*rfunc) (")
+    (while args
+      (if (/= ctr 0)
+         (insert ", "))
+      (insert (format "GTK_VALUE_%s (args[%d])" (car args) ctr))
+      (setq args (cdr args)
+           ctr (1+ ctr)))
+    (insert ");\n")
+    (insert "}\n")))
+
+(save-excursion
+  (find-file "../../src/emacs-marshals.c")
+  (erase-buffer)
+  (setq defined-marshallers nil)
+
+  (insert "#define GTK_VALUE_ARRAY(x) GTK_VALUE_POINTER(x)\n\n")
+  (insert "#define GTK_VALUE_LIST(x) GTK_VALUE_POINTER(x)\n\n")
+
+  (let ((todo '(
+               ("BOOL" "OBJECT" "INT")
+               ("BOOL" "OBJECT" "OBJECT" "OBJECT")
+               ("BOOL" "OBJECT" "OBJECT")
+               ("BOOL" "OBJECT" "POINTER")
+               ("BOOL" "OBJECT" "STRING")
+               ("BOOL" "OBJECT")
+               ("BOOL" "POINTER" "BOOL")
+               ("BOOL" "POINTER")
+               ("BOOL")
+               ("FLOAT" "OBJECT" "FLOAT")
+               ("FLOAT" "OBJECT")
+               ("INT" "BOOL")
+               ("INT" "OBJECT" "ARRAY")
+               ("INT" "OBJECT" "INT" "ARRAY")
+               ("INT" "OBJECT" "INT" "INT")
+               ("INT" "OBJECT" "INT" "STRING")
+               ("INT" "OBJECT" "INT")
+               ("INT" "OBJECT" "OBJECT")
+               ("INT" "OBJECT" "POINTER" "INT" "INT")
+               ("INT" "OBJECT" "POINTER" "INT")
+               ("INT" "OBJECT" "POINTER")
+               ("INT" "OBJECT" "STRING")
+               ("INT" "OBJECT")
+               ("INT" "POINTER" "INT")
+               ("INT" "POINTER" "STRING" "INT")
+               ("INT" "POINTER" "STRING" "STRING")
+               ("INT" "POINTER" "STRING")
+               ("INT" "POINTER")
+               ("INT" "STRING" "STRING" "INT" "ARRAY")
+               ("INT" "STRING")
+               ("INT")
+               ("LIST" "OBJECT")
+               ("LIST")
+               ("NONE" "BOOL")
+               ("NONE" "INT" "INT" "INT" "INT")
+               ("NONE" "INT" "INT")
+               ("NONE" "INT")
+               ("NONE" "OBJECT" "BOOL" "INT")
+               ("NONE" "OBJECT" "BOOL")
+               ("NONE" "OBJECT" "FLOAT" "FLOAT" "FLOAT" "BOOL")
+               ("NONE" "OBJECT" "FLOAT" "FLOAT" "FLOAT" "FLOAT")
+               ("NONE" "OBJECT" "FLOAT" "FLOAT" "FLOAT")
+               ("NONE" "OBJECT" "FLOAT" "FLOAT")
+               ("NONE" "OBJECT" "FLOAT")
+               ("NONE" "OBJECT" "INT" "BOOL")
+               ("NONE" "OBJECT" "INT" "FLOAT" "BOOL")
+               ("NONE" "OBJECT" "INT" "FLOAT")
+               ("NONE" "OBJECT" "INT" "INT" "ARRAY" "ARRAY" "ARRAY" "ARRAY" "ARRAY" "ARRAY")
+               ("NONE" "OBJECT" "INT" "INT" "ARRAY")
+               ("NONE" "OBJECT" "INT" "INT" "FLOAT" "FLOAT")
+               ("NONE" "OBJECT" "INT" "INT" "INT" "INT")
+               ("NONE" "OBJECT" "INT" "INT" "INT")
+               ("NONE" "OBJECT" "INT" "INT" "POINTER" "POINTER")
+               ("NONE" "OBJECT" "INT" "INT" "POINTER")
+               ("NONE" "OBJECT" "INT" "INT" "STRING" "INT" "POINTER" "POINTER")
+               ("NONE" "OBJECT" "INT" "INT" "STRING")
+               ("NONE" "OBJECT" "INT" "INT")
+               ("NONE" "OBJECT" "INT" "OBJECT")
+               ("NONE" "OBJECT" "INT" "POINTER")
+               ("NONE" "OBJECT" "INT" "STRING")
+               ("NONE" "OBJECT" "INT")
+               ("NONE" "OBJECT" "LIST" "INT")
+               ("NONE" "OBJECT" "LIST")
+               ("NONE" "OBJECT" "OBJECT" "BOOL" "BOOL" "INT" "INT")
+               ("NONE" "OBJECT" "OBJECT" "BOOL" "BOOL" "INT")
+               ("NONE" "OBJECT" "OBJECT" "BOOL" "BOOL")
+               ("NONE" "OBJECT" "OBJECT" "FLOAT" "INT")
+               ("NONE" "OBJECT" "OBJECT" "INT" "INT" "INT" "INT" "INT" "INT" "INT" "INT")
+               ("NONE" "OBJECT" "OBJECT" "INT" "INT" "INT" "INT")
+               ("NONE" "OBJECT" "OBJECT" "INT" "INT" "INT")
+               ("NONE" "OBJECT" "OBJECT" "INT" "INT")
+               ("NONE" "OBJECT" "OBJECT" "INT")
+               ("NONE" "OBJECT" "OBJECT" "OBJECT" "INT")
+               ("NONE" "OBJECT" "OBJECT" "OBJECT" "OBJECT" "INT")
+               ("NONE" "OBJECT" "OBJECT" "OBJECT" "OBJECT")
+               ("NONE" "OBJECT" "OBJECT" "OBJECT" "POINTER" "POINTER" "INT" "INT")
+               ("NONE" "OBJECT" "OBJECT" "OBJECT")
+               ("NONE" "OBJECT" "OBJECT" "POINTER")
+               ("NONE" "OBJECT" "OBJECT" "STRING" "INT" "INT" "INT" "INT" "INT")
+               ("NONE" "OBJECT" "OBJECT" "STRING" "STRING" "INT")
+               ("NONE" "OBJECT" "OBJECT" "STRING" "STRING")
+               ("NONE" "OBJECT" "OBJECT" "STRING")
+               ("NONE" "OBJECT" "OBJECT")
+               ("NONE" "OBJECT" "POINTER" "BOOL")
+               ("NONE" "OBJECT" "POINTER" "INT" "FLOAT" "FLOAT")
+               ("NONE" "OBJECT" "POINTER" "INT" "INT" "INT")
+               ("NONE" "OBJECT" "POINTER" "INT" "INT")
+               ("NONE" "OBJECT" "POINTER" "INT" "POINTER" "POINTER")
+               ("NONE" "OBJECT" "POINTER" "INT" "POINTER")
+               ("NONE" "OBJECT" "POINTER" "INT" "STRING" "INT" "POINTER" "POINTER")
+               ("NONE" "OBJECT" "POINTER" "INT" "STRING")
+               ("NONE" "OBJECT" "POINTER" "INT")
+               ("NONE" "OBJECT" "POINTER" "POINTER" "INT" "INT" "INT" "INT" "INT" "INT")
+               ("NONE" "OBJECT" "POINTER" "POINTER" "POINTER" "STRING" "INT")
+               ("NONE" "OBJECT" "POINTER" "POINTER" "POINTER")
+               ("NONE" "OBJECT" "POINTER" "POINTER")
+               ("NONE" "OBJECT" "POINTER" "STRING" "INT" "POINTER" "POINTER" "POINTER" "POINTER" "BOOL" "BOOL")
+               ("NONE" "OBJECT" "POINTER")
+               ("NONE" "OBJECT" "STRING" "BOOL")
+               ("NONE" "OBJECT" "STRING" "INT" "INT" "INT")
+               ("NONE" "OBJECT" "STRING" "POINTER" "INT" "INT" "INT")
+               ("NONE" "OBJECT" "STRING" "POINTER" "INT" "INT")
+               ("NONE" "OBJECT" "STRING" "STRING")
+               ("NONE" "OBJECT" "STRING")
+               ("NONE" "OBJECT")
+               ("NONE" "POINTER" "INT")
+               ("NONE" "POINTER" "INT" "INT")
+               ("NONE" "POINTER" "POINTER" "BOOL" "INT" "INT" "INT" "INT" "INT" "INT")
+               ("NONE" "POINTER" "POINTER" "BOOL" "INT" "INT" "INT" "INT")
+               ("NONE" "POINTER" "POINTER" "INT" "INT" "INT" "INT")
+               ("NONE" "POINTER" "POINTER" "INT" "INT")
+               ("NONE" "POINTER" "POINTER" "POINTER" "INT" "INT" "STRING" "INT")
+               ("NONE" "POINTER" "POINTER" "POINTER" "INT" "INT" "STRING")
+               ("NONE" "POINTER" "POINTER" "POINTER" "POINTER")
+               ("NONE" "POINTER" "POINTER")
+               ("NONE" "POINTER" "STRING" "STRING")
+               ("NONE" "POINTER" "STRING")
+               ("NONE" "POINTER")
+               ("NONE")
+               ("OBJECT" "BOOL" "BOOL" "INT")
+               ("OBJECT" "BOOL" "INT")
+               ("OBJECT" "FLOAT" "FLOAT" "FLOAT" "FLOAT" "FLOAT" "FLOAT")
+               ("OBJECT" "FLOAT" "FLOAT" "FLOAT" "FLOAT" "FLOAT")
+               ("OBJECT" "FLOAT" "FLOAT" "FLOAT" "FLOAT")
+               ("OBJECT" "INT" "ARRAY")
+               ("OBJECT" "INT" "BOOL" "BOOL")
+               ("OBJECT" "INT" "INT" "ARRAY")
+               ("OBJECT" "INT" "INT" "BOOL")
+               ("OBJECT" "INT" "INT" "STRING")
+               ("OBJECT" "INT" "INT")
+               ("OBJECT" "INT")
+               ("OBJECT" "OBJECT" "FLOAT" "INT")
+               ("OBJECT" "OBJECT" "INT")
+               ("OBJECT" "OBJECT" "OBJECT")
+               ("OBJECT" "OBJECT" "STRING" "INT" "INT" "INT" "INT" "INT")
+               ("OBJECT" "OBJECT" "STRING" "INT" "INT" "INT" "INT")
+               ("OBJECT" "OBJECT" "STRING" "INT" "INT")
+               ("OBJECT" "OBJECT" "STRING")
+               ("OBJECT" "OBJECT")
+               ("OBJECT" "POINTER" "POINTER")
+               ("OBJECT" "POINTER" "STRING")
+               ("OBJECT" "POINTER")
+               ("OBJECT" "STRING" "FLOAT" "FLOAT" "FLOAT" "BOOL")
+               ("OBJECT" "STRING" "INT" "STRING" "STRING")
+               ("OBJECT" "STRING" "OBJECT")
+               ("OBJECT" "STRING" "STRING" "STRING" "ARRAY" "STRING" "STRING")
+               ("OBJECT" "STRING" "STRING")
+               ("OBJECT" "STRING")
+               ("OBJECT")
+               ("POINTER" "INT" "INT")
+               ("POINTER" "INT")
+               ("POINTER" "OBJECT" "INT" "INT")
+               ("POINTER" "OBJECT" "INT")
+               ("POINTER" "OBJECT" "POINTER" "INT")
+               ("POINTER" "OBJECT" "POINTER" "POINTER" "ARRAY" "INT" "POINTER" "POINTER" "POINTER" "POINTER" "BOOL" "BOOL")
+               ("POINTER" "OBJECT" "POINTER")
+               ("POINTER" "OBJECT")
+               ("POINTER" "POINTER")
+               ("POINTER")
+               ("STRING" "INT" "INT" "INT")
+               ("STRING" "INT")
+               ("STRING" "OBJECT" "BOOL")
+               ("STRING" "OBJECT" "FLOAT")
+               ("STRING" "OBJECT" "INT" "INT")
+               ("STRING" "OBJECT" "INT")
+               ("STRING" "OBJECT")
+               ("STRING" "POINTER" "STRING")
+               ("STRING" "POINTER")
+               ("STRING")
+               )
+             )
+       )
+    (mapc (lambda (x) (apply 'define-marshaller x)) todo)
+
+    (insert "\n\f
+#include \"hash.h\"
+static c_hashtable marshaller_hashtable;
+
+static void initialize_marshaller_storage (void)
+{
+       if (!marshaller_hashtable)
+       {
+               marshaller_hashtable = make_strings_hashtable (100);
+")
+    
+    (mapc (lambda (x)
+           (let ((name (get-marshaller-name (car x) (cdr x))))
+             (insert (format "\t\tputhash (\"%s\", (void *) %s, marshaller_hashtable);\n" name name))))
+         todo)
+    (insert "\t};\n"
+           "}\n"
+           "
+static void *find_marshaller (const char *func_name)
+{
+       void *fn = NULL;
+       initialize_marshaller_storage ();
+
+       if (gethash (func_name, marshaller_hashtable, (CONST void **)&fn))
+       {
+               return (fn);
+       }
+
+       return (NULL);
+}
+"))
+
+  (save-buffer)
+  (kill-buffer "emacs-marshals.c"))

diff --git a/lisp/gtk-mouse.el b/lisp/gtk-mouse.el
new file mode 100644 (file)
index 0000000..61eca21
--- /dev/null
+++ b/lisp/gtk-mouse.el
@@ -0,0 +1,72 @@
+;;; gtk-mouse.el --- Mouse support for GTK window system.
+
+;; Copyright (C) 1985, 1992-4, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996 Ben Wing.
+;; Copyright (C) 2000 William Perry
+
+;; Maintainer: XEmacs Development Team
+;; Keywords: mouse, 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Synched up with: Not synched.
+
+;;; Commentary:
+
+;; This file is dumped with XEmacs (when GTK support is compiled in).
+
+;;; Code:
+
+(defvar gtk-pointers-initialized nil)
+
+(defun gtk-init-pointers ()
+  (if gtk-pointers-initialized
+      nil
+    (set-glyph-image text-pointer-glyph
+                    [gtk-resource :resource-type cursor :resource-id xterm]
+                    'gtk)
+    (set-glyph-image nontext-pointer-glyph
+                    [gtk-resource :resource-type cursor :resource-id xterm]
+                    'gtk)
+    (set-glyph-image selection-pointer-glyph
+                    [gtk-resource :resource-type cursor :resource-id top-left-arrow]
+                    'gtk)
+    (set-glyph-image modeline-pointer-glyph
+                    [gtk-resource :resource-type cursor :resource-id sb-v-double-arrow]
+                    'gtk)
+    (set-glyph-image divider-pointer-glyph
+                    [gtk-resource :resource-type cursor :resource-id sb-h-double-arrow]
+                    'gtk)
+    (set-glyph-image busy-pointer-glyph
+                    [gtk-resource :resource-type cursor :resource-id watch]
+                    'gtk)
+    (set-glyph-image gc-pointer-glyph
+                    [gtk-resource :resource-type cursor :resource-id watch]
+                    'gtk)
+
+    (when (featurep 'toolbar)
+      (set-glyph-image toolbar-pointer-glyph
+                      [gtk-resource :resource-type cursor :resource-id top-left-arrow]
+                      'gtk))
+
+    (when (featurep 'scrollbar)
+      (set-glyph-image scrollbar-pointer-glyph
+                      [gtk-resource :resource-type cursor :resource-id top-left-arrow]
+                      'gtk))
+
+    (setq gtk-pointers-initialized t)))

diff --git a/lisp/gtk-package.el b/lisp/gtk-package.el
new file mode 100644 (file)
index 0000000..1da2db9
--- /dev/null
+++ b/lisp/gtk-package.el
@@ -0,0 +1,10 @@
+;; A GTK version of package-ui.el
+
+(require 'package-get)
+(require 'package-ui)
+
+(defun package-gtk-edit-sites ()
+  (let ((window (gtk-window-new 'toplevel))
+       (box (gtk-hbox-new nil 5)))
+    (gtk-container-add window box)
+    (gtk-widget-show-all window)))

diff --git a/lisp/gtk-password-dialog.el b/lisp/gtk-password-dialog.el
new file mode 100644 (file)
index 0000000..c503495
--- /dev/null
+++ b/lisp/gtk-password-dialog.el
@@ -0,0 +1,122 @@
+;;; gtk-password-dialog.el --- Reading passwords in a dialog
+
+;; Copyright (C) 2000 Free Software Foundation, Inc.
+
+;; Maintainer: William M. Perry <wmperry@gnu.org>
+;; Keywords: extensions, internal
+
+;; 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.
+
+(defun gtk-password-dialog-ok-button (dlg)
+  (get dlg 'x-ok-button))
+
+(defun gtk-password-dialog-cancel-button (dlg)
+  (get dlg 'x-cancel-button))
+
+(defun gtk-password-dialog-entry-widget (dlg)
+  (get dlg 'x-initial-entry))
+
+(defun gtk-password-dialog-confirmation-widget (dlg)
+  (get dlg 'x-verify-entry))
+
+(defun gtk-password-dialog-new (&rest keywords)
+  ;; Format is (:keyword value ...)
+  ;; Allowed keywords are:
+  ;;
+  ;;  :callback function
+  ;;  :default string
+  ;;  :title string
+  :;  :prompt string
+  ;;  :default string
+  ;;  :verify boolean
+  ;;  :verify-prompt string
+  (let* ((callback (plist-get keywords :callback 'ignore))
+        (dialog (gtk-dialog-new))
+        (vbox (gtk-dialog-vbox dialog))
+        (button-area (gtk-dialog-action-area dialog))
+        (default (plist-get keywords :default))
+        (widget nil))
+    (gtk-window-set-title dialog (plist-get keywords :title "Enter password..."))
+
+    ;; Make us modal...
+    (put dialog 'type 'dialog)
+
+    ;; Put the buttons in the bottom
+    (setq widget (gtk-button-new-with-label "OK"))
+    (gtk-container-add button-area widget)
+    (gtk-signal-connect widget 'clicked
+                       (lambda (button data)
+                         (funcall (car data)
+                                  (gtk-entry-get-text
+                                   (get (cdr data) 'x-initial-entry))))
+                       (cons callback dialog))
+    (put dialog 'x-ok-button widget)
+
+    (setq widget (gtk-button-new-with-label "Cancel"))
+    (gtk-container-add button-area widget)
+    (gtk-signal-connect widget 'clicked
+                       (lambda (button dialog)
+                         (gtk-widget-destroy dialog))
+                       dialog)
+    (put dialog 'x-cancel-button widget)
+
+    ;; Now the entry area...
+    (gtk-container-set-border-width vbox 5)
+    (setq widget (gtk-label-new (plist-get keywords :prompt "Password:")))
+    (gtk-misc-set-alignment widget 0.0 0.5)
+    (gtk-container-add vbox widget)
+
+    (setq widget (gtk-entry-new))
+    (put widget 'visibility nil)
+    (gtk-container-add vbox widget)
+    (put dialog 'x-initial-entry widget)
+
+    (if (plist-get keywords :verify)
+       (let ((changed-cb (lambda (editable dialog)
+                           (gtk-widget-set-sensitive
+                            (get dialog 'x-ok-button)
+                            (equal (gtk-entry-get-text
+                                    (get dialog 'x-initial-entry))
+                                   (gtk-entry-get-text
+                                    (get dialog 'x-verify-entry)))))))
+         (gtk-container-set-border-width vbox 5)
+         (setq widget (gtk-label-new (plist-get keywords :verify-prompt "Verify:")))
+         (gtk-misc-set-alignment widget 0.0 0.5)
+         (gtk-container-add vbox widget)
+
+         (setq widget (gtk-entry-new))
+         (put widget 'visibility nil)
+         (gtk-container-add vbox widget)
+         (put dialog 'x-verify-entry widget)
+
+         (gtk-signal-connect (get dialog 'x-initial-entry)
+                             'changed changed-cb dialog)
+         (gtk-signal-connect (get dialog 'x-verify-entry)
+                             'changed changed-cb dialog)
+         (gtk-widget-set-sensitive (get dialog 'x-ok-button) nil)))
+
+    (if default
+       (progn
+         (gtk-entry-set-text (get dialog 'x-initial-entry) default)
+         (gtk-entry-select-region (get dialog 'x-initial-entry)
+                                  0 (length default))))
+    dialog))
+
+(provide 'gtk-password-dialog)

diff --git a/lisp/gtk-select.el b/lisp/gtk-select.el
new file mode 100644 (file)
index 0000000..76b30df
--- /dev/null
+++ b/lisp/gtk-select.el
@@ -0,0 +1,65 @@
+;;; gtk-select.el --- Lisp interface to GTK selections.
+
+;; Copyright (C) 1990, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1995 Sun Microsystems.
+;; Copyright (C) 2000 Free Software Foundation
+
+;; Maintainer: William Perry <wmperry@gnu.org>
+;; Keywords: extensions, 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+;; This file is dumped with XEmacs (when GTK support is compiled in).
+;; #### Only copes with copying/pasting text
+
+;;; Code:
+
+(defun gtk-get-secondary-selection ()
+  "Return text selected from some GTK window."
+  (get-selection 'SECONDARY))
+
+(defun gtk-own-secondary-selection (selection &optional type)
+  "Make a secondary GTK Selection of the given argument.  The argument may be a
+string or a cons of two markers (in which case the selection is considered to
+be the text between those markers)."
+  (interactive (if (not current-prefix-arg)
+                  (list (read-string "Store text for pasting: "))
+                (list (cons ;; these need not be ordered.
+                       (copy-marker (point-marker))
+                       (copy-marker (mark-marker))))))
+  (own-selection selection 'SECONDARY))
+
+(defun gtk-notice-selection-requests (selection type successful)
+  "for possible use as the value of `gtk-sent-selection-hooks'."
+  (if (not successful)
+      (message "Selection request failed to convert %s to %s"
+              selection type)
+    (message "Sent selection %s as %s" selection type)))
+
+(defun gtk-notice-selection-failures (selection type successful)
+  "for possible use as the value of `gtk-sent-selection-hooks'."
+  (or successful
+      (message "Selection request failed to convert %s to %s"
+              selection type)))
+
+;(setq gtk-sent-selection-hooks 'gtk-notice-selection-requests)
+;(setq gtk-sent-selection-hooks 'gtk-notice-selection-failures)

diff --git a/lisp/gtk-widget-accessors.el b/lisp/gtk-widget-accessors.el
new file mode 100644 (file)
index 0000000..fd56920
--- /dev/null
+++ b/lisp/gtk-widget-accessors.el
@@ -0,0 +1,258 @@
+(require 'gtk-ffi)
+
+(defconst GTK_TYPE_INVALID 0)
+(defconst GTK_TYPE_NONE 1)
+(defconst GTK_TYPE_CHAR 2)
+(defconst GTK_TYPE_UCHAR 3)
+(defconst GTK_TYPE_BOOL 4)
+(defconst GTK_TYPE_INT 5)
+(defconst GTK_TYPE_UINT 6)
+(defconst GTK_TYPE_LONG 7)
+(defconst GTK_TYPE_ULONG 8)
+(defconst GTK_TYPE_FLOAT 9)
+(defconst GTK_TYPE_DOUBLE 10)
+(defconst GTK_TYPE_STRING 11)
+(defconst GTK_TYPE_ENUM 12)
+(defconst GTK_TYPE_FLAGS 13)
+(defconst GTK_TYPE_BOXED 14)
+(defconst GTK_TYPE_POINTER 15)
+(defconst GTK_TYPE_SIGNAL 16)
+(defconst GTK_TYPE_ARGS 17)
+(defconst GTK_TYPE_CALLBACK 18)
+(defconst GTK_TYPE_C_CALLBACK 19)
+(defconst GTK_TYPE_FOREIGN 20)
+(defconst GTK_TYPE_OBJECT 21)
+
+(defconst gtk-value-accessor-names
+  '("INVALID" "NONE" "CHAR" "UCHAR" "BOOL" "INT" "UINT" "LONG" "ULONG" "FLOAT" "DOUBLE"
+    "STRING" "ENUM" "FLAGS" "BOXED" "POINTER" "SIGNAL" "ARGS" "CALLBACK" "C_CALLBACK"
+    "FOREIGN" "OBJECT"))
+
+(defun define-widget-accessors (gtk-class
+                               wrapper
+                               prefix args)
+  "Output stub C code to access parts of a widget from lisp.
+GTK-CLASS is the GTK class to grant access to.
+WRAPPER is a fragment to construct GTK C macros for typechecking/etc. (ie: WIDGET)
+ARGS is a list of (type . name) cons cells.
+Defines a whole slew of functions to access & set the slots in the
+structure."
+  (set-buffer (get-buffer-create "emacs-widget-accessors.c"))
+  (goto-char (point-max))
+  (let ((arg)
+       (base-arg-type nil)
+       (lisp-func-name nil)
+       (c-func-name nil)
+       (func-names nil))
+    (setq gtk-class (symbol-name gtk-class)
+         wrapper (upcase wrapper))
+    (while (setq arg (pop args))
+      (setq lisp-func-name (format "gtk-%s-%s" prefix (cdr arg))
+           lisp-func-name (replace-in-string lisp-func-name "_" "-")
+           c-func-name (concat "F" (replace-in-string lisp-func-name "-" "_")))
+      (insert
+       "DEFUN (\"" lisp-func-name "\", " c-func-name ", 1, 1, 0, /*\n"
+       "Access the `" (symbol-name (cdr arg)) "' slot of OBJ, a " gtk-class " object.\n"
+       "*/\n"
+       "\t(obj))\n"
+       "{\n"
+       (format "\t%s *the_obj = NULL;\n" gtk-class)
+       "\tGtkArg arg;\n"
+       "\n"
+       "\tCHECK_GTK_OBJECT (obj);\n"
+       "\n"
+       (format "\tif (!GTK_IS_%s (XGTK_OBJECT (obj)->object))\n" wrapper)
+       "\t{\n"
+       (format "\t\tsignal_simple_error (\"Object is not a %s\", obj);\n" gtk-class)
+       "\t};\n"
+       "\n"
+       (format "\tthe_obj = GTK_%s (XGTK_OBJECT (obj)->object);\n" wrapper)
+
+       (format "\targ.type = gtk_type_from_name (\"%s\");\n" (symbol-name (car arg))))
+;       (format "\targ.type = GTK_TYPE_%s;\n" (or
+;                                             (nth (gtk-fundamental-type (car arg))
+;                                                  gtk-value-accessor-names)
+;                                             (case (car arg)
+;                                               (GtkListOfString "STRING_LIST")
+;                                               (GtkListOfObject "OBJECT_LIST")
+;                                               (otherwise
+;                                                "POINTER")))))
+
+      (setq base-arg-type (gtk-fundamental-type (car arg)))
+      (cond
+       ((= base-arg-type GTK_TYPE_OBJECT)
+       (insert
+        (format "\tGTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->%s);"
+                (cdr arg))))
+       ((or (= base-arg-type GTK_TYPE_POINTER)
+           (= base-arg-type GTK_TYPE_BOXED))
+       (insert
+        (format "\tGTK_VALUE_%s (arg) = (void *)the_obj->%s;"
+                (nth (gtk-fundamental-type (car arg)) gtk-value-accessor-names)
+                (cdr arg))))
+       (t
+       (insert
+        (format "\tGTK_VALUE_%s (arg) = the_obj->%s;"
+                (or (nth (gtk-fundamental-type (car arg)) gtk-value-accessor-names) "POINTER")
+                (cdr arg)))))
+      (insert
+       "\n"
+       "\treturn (gtk_type_to_lisp (&arg));\n"
+       "}\n\n")
+      (push c-func-name func-names))
+    func-names))
+
+(defun import-widget-accessors (file syms-function-name &rest description)
+  "Import multiple widgets, and emit a suitable vars_of_foo() function for them.\n"
+  (let ((c-mode-common-hook nil)
+       (c-mode-hook nil))
+    (find-file file))
+  (erase-buffer)
+  (let ((c-funcs nil))
+    (while description
+      (setq c-funcs (nconc (define-widget-accessors
+                            (pop description) (pop description)
+                            (pop description) (pop description)) c-funcs)))
+    (goto-char (point-max))
+    (insert "void " syms-function-name " (void)\n"
+           "{\n\t"
+           (mapconcat (lambda (x)
+                        (concat "DEFSUBR (" x ");")) c-funcs "\n\t")
+           "\n}"))
+  (save-buffer))
+
+;; Because the new FFI layer imports GTK types lazily, we need to load
+;; up all of the gtk types we know about, or we get errors about
+;; unknown GTK types later on.
+(mapatoms (lambda (sym)
+           (if (string-match "gtk-[^-]+-get-type" (symbol-name sym))
+               (funcall sym))))
+
+(import-widget-accessors
+ "../../src/emacs-widget-accessors.c"
+ "syms_of_widget_accessors "
+
+ 'GtkAdjustment "ADJUSTMENT" "adjustment"
+ '((gfloat . lower)
+   (gfloat . upper)
+   (gfloat . value)
+   (gfloat . step_increment)
+   (gfloat . page_increment)
+   (gfloat . page_size))
+
+ 'GtkWidget "WIDGET" "widget"
+ '((GtkStyle     . style)
+   (GdkWindow    . window)
+   (GtkStateType . state)
+   (GtkString    . name)
+   (GtkWidget    . parent))
+
+ 'GtkButton "BUTTON" "button"
+ '((GtkWidget  . child)
+   (gboolean   . in_button)
+   (gboolean   . button_down))
+
+ 'GtkCombo "COMBO" "combo"
+ '((GtkWidget  . entry)
+   (GtkWidget  . button)
+   (GtkWidget  . popup)
+   (GtkWidget  . popwin)
+   (GtkWidget  . list))
+
+ 'GtkGammaCurve "GAMMA_CURVE" "gamma-curve"
+ '((GtkWidget  . table)
+   (GtkWidget  . curve)
+   (gfloat      . gamma)
+   (GtkWidget  . gamma_dialog)
+   (GtkWidget  . gamma_text))
+
+ 'GtkCheckMenuItem "CHECK_MENU_ITEM" "check-menu-item"
+ '((gboolean   . active))
+
+ 'GtkNotebook "NOTEBOOK" "notebook"
+ '((GtkPositionType . tab_pos))
+
+ 'GtkText "TEXT" "text"
+ '((GtkAdjustment . hadj)
+   (GtkAdjustment . vadj))
+
+ 'GtkFileSelection "FILE_SELECTION" "file-selection"
+ '((GtkWidget . dir_list)
+   (GtkWidget . file_list)
+   (GtkWidget . selection_entry)
+   (GtkWidget . selection_text)
+   (GtkWidget . main_vbox)
+   (GtkWidget . ok_button)
+   (GtkWidget . cancel_button)
+   (GtkWidget . help_button)
+   (GtkWidget . action_area))
+
+ 'GtkFontSelectionDialog "FONT_SELECTION_DIALOG" "font-selection-dialog"
+ '((GtkWidget . fontsel)
+   (GtkWidget . main_vbox)
+   (GtkWidget . action_area)
+   (GtkWidget . ok_button)
+   (GtkWidget . apply_button)
+   (GtkWidget . cancel_button))
+
+ 'GtkColorSelectionDialog "COLOR_SELECTION_DIALOG" "color-selection-dialog"
+ '((GtkWidget . colorsel)
+   (GtkWidget . main_vbox)
+   (GtkWidget . ok_button)
+   (GtkWidget . reset_button)
+   (GtkWidget . cancel_button)
+   (GtkWidget . help_button))
+
+ 'GtkDialog "DIALOG" "dialog"
+ '((GtkWidget . vbox)
+   (GtkWidget . action_area))
+
+ 'GtkInputDialog "INPUT_DIALOG" "input-dialog"
+ '((GtkWidget . close_button)
+   (GtkWidget . save_button))
+
+ 'GtkPlug "PLUG" "plug"
+ '((GdkWindow . socket_window)
+   (gint      . same_app))
+
+ 'GtkObject "OBJECT" "object"
+ '((guint     . flags)
+   (guint     . ref_count))
+
+ 'GtkPaned "PANED" "paned"
+ '((GtkWidget . child1)
+   (GtkWidget . child2)
+   (gboolean  . child1_resize)
+   (gboolean  . child2_resize)
+   (gboolean  . child1_shrink)
+   (gboolean  . child2_shrink))
+
+ 'GtkCList "CLIST" "clist"
+ '((gint . rows)
+   (gint . columns)
+   (GtkAdjustment . hadjustment)
+   (GtkAdjustment . vadjustment)
+   (GtkSortType   . sort_type)
+   (gint . focus_row)
+   (gint . sort_column))
+
+ 'GtkList "LIST" "list"
+ '((GtkListOfObject . children)
+   (GtkListOfObject . selection))
+
+ 'GtkTree "TREE" "tree"
+ '((GtkListOfObject . children)
+   (GtkTree         . root_tree)
+   (GtkWidget       . tree_owner)
+   (GtkListOfObject . selection))
+
+ 'GtkTreeItem "TREE_ITEM" "tree-item"
+ '((GtkWidget       . subtree))
+
+ 'GtkScrolledWindow "SCROLLED_WINDOW" "scrolled-window"
+ '((GtkWidget . hscrollbar)
+   (GtkWidget . vscrollbar)
+   (gboolean  . hscrollbar_visible)
+   (gboolean  . vscrollbar_visible))
+
+ )

diff --git a/lisp/gtk-widgets.el b/lisp/gtk-widgets.el
new file mode 100644 (file)
index 0000000..075594c
--- /dev/null
+++ b/lisp/gtk-widgets.el
@@ -0,0 +1,2080 @@
+;;; gtk-widgets.el --- Import GTK functions into XEmacs
+
+;; Copyright (C) 2000 Free Software Foundation
+
+;; Maintainer: William Perry <wmperry@gnu.org>
+;; Keywords: extensions, 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, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+;; This file is dumped with XEmacs.
+
+(eval-and-compile
+  (require 'gtk-ffi))
+
+(gtk-import-function GtkType gtk_accel_label_get_type)
+(gtk-import-function GtkWidget gtk_accel_label_new GtkString)
+(gtk-import-function guint gtk_accel_label_get_accel_width GtkAccelLabel)
+(gtk-import-function nil gtk_accel_label_set_accel_widget GtkAccelLabel GtkWidget)
+(gtk-import-function gboolean gtk_accel_label_refetch GtkAccelLabel)
+
+\f
+(gtk-import-function GtkType gtk_adjustment_get_type)
+(gtk-import-function GtkObject gtk_adjustment_new gfloat gfloat gfloat gfloat gfloat gfloat)
+(gtk-import-function nil gtk_adjustment_changed GtkAdjustment)
+(gtk-import-function nil gtk_adjustment_value_changed GtkAdjustment)
+(gtk-import-function nil gtk_adjustment_clamp_page GtkAdjustment gfloat gfloat)
+(gtk-import-function nil gtk_adjustment_set_value GtkAdjustment gfloat)
+
+\f
+(gtk-import-function GtkType gtk_alignment_get_type)
+(gtk-import-function GtkWidget gtk_alignment_new gfloat gfloat gfloat gfloat)
+(gtk-import-function nil gtk_alignment_set GtkAlignment gfloat gfloat gfloat gfloat)
+
+\f
+(gtk-import-function GtkType gtk_arrow_get_type)
+(gtk-import-function GtkWidget gtk_arrow_new GtkArrowType GtkShadowType)
+(gtk-import-function nil gtk_arrow_set GtkArrow GtkArrowType GtkShadowType)
+
+\f
+(gtk-import-function GtkType gtk_aspect_frame_get_type)
+(gtk-import-function GtkWidget gtk_aspect_frame_new GtkString gfloat gfloat gfloat gboolean)
+(gtk-import-function nil gtk_aspect_frame_set GtkAspectFrame gfloat gfloat gfloat gboolean)
+
+\f
+(gtk-import-function GtkType gtk_bin_get_type)
+
+\f
+(gtk-import-function GtkType gtk_box_get_type)
+(gtk-import-function nil gtk_box_pack_start
+                    (GtkBox     . box)
+                    (GtkWidget  . child)
+                    (gboolean   . expand)
+                    (gboolean   . fill)
+                    (guint      . padding))
+
+(gtk-import-function nil gtk_box_pack_end
+                    (GtkBox     . box)
+                    (GtkWidget  . child)
+                    (gboolean   . expand)
+                    (gboolean   . fill)
+                    (guint      . padding))
+
+(gtk-import-function nil gtk_box_pack_start_defaults
+                    (GtkBox     . box)
+                    (GtkWidget  . child))
+
+(gtk-import-function nil gtk_box_pack_end_defaults
+                    (GtkBox     . box)
+                    (GtkWidget  . child))
+
+(gtk-import-function nil gtk_box_set_homogeneous
+                    (GtkBox     . box)
+                    (gboolean   . homogeneous))
+
+(gtk-import-function nil gtk_box_set_spacing
+                    (GtkBox     . box)
+                    (gint       . spacing))
+
+(gtk-import-function nil gtk_box_reorder_child
+                    (GtkBox      . box)
+                    (GtkWidget  . child)
+                    (gint       . position))
+
+;;;Handcoded in ui-byhand.c... #### FIXME
+;;;void           gtk_box_query_child_packing (GtkBox       *box,
+;;;                                    GtkWidget    *child,
+;;;                                    gboolean     *expand,
+;;;                                    gboolean     *fill,
+;;;                                    guint        *padding,
+;;;                                    GtkPackType  *pack_type);
+
+(gtk-import-function nil gtk_box_set_child_packing
+                    (GtkBox      . box)
+                    (GtkWidget   . child)
+                    (gboolean    . expand)
+                    (gboolean    . fill)
+                    (guint       . padding)
+                    (GtkPackType . pack_type))
+
+\f
+(gtk-import-function GtkType gtk_button_get_type)
+(gtk-import-function GtkWidget gtk_button_new)
+(gtk-import-function GtkWidget gtk_button_new_with_label GtkString)
+(gtk-import-function nil gtk_button_pressed GtkButton)
+(gtk-import-function nil gtk_button_released GtkButton)
+(gtk-import-function nil gtk_button_clicked GtkButton)
+(gtk-import-function nil gtk_button_enter GtkButton)
+(gtk-import-function nil gtk_button_leave GtkButton)
+(gtk-import-function nil gtk_button_set_relief GtkButton GtkReliefStyle)
+(gtk-import-function GtkReliefStyle gtk_button_get_relief GtkButton)
+
+(defun gtk-button-new-with-pixmap (glyph)
+  "Construct a new GtkButton object with a pixmap."
+  (let ((button (gtk-button-new))
+       (pixmap nil))
+    (if (glyphp glyph)
+       (setq pixmap (gtk-pixmap-new glyph nil))
+      (setq pixmap glyph))
+    (gtk-widget-show pixmap)
+    (gtk-container-add button pixmap)
+    button))
+
+\f
+(gtk-import-function GtkType gtk_button_box_get_type)
+
+;Handcoded in ui-byhand.c... #### FIXME
+;;;void gtk_button_box_get_child_size_default (gint *min_width, gint *min_height);
+;;;void gtk_button_box_get_child_ipadding_default (gint *ipad_x, gint *ipad_y);
+
+(gtk-import-function nil gtk_button_box_set_child_size_default gint gint)
+(gtk-import-function nil gtk_button_box_set_child_ipadding_default gint gint)
+(gtk-import-function gint gtk_button_box_get_spacing GtkButtonBox)
+(gtk-import-function GtkButtonBoxStyle gtk_button_box_get_layout GtkButtonBox)
+
+;Handcoded in ui-byhand.c... #### FIXME
+;;;void gtk_button_box_get_child_size (GtkButtonBox *widget,
+;;;                                gint *min_width, gint *min_height);
+;;;void gtk_button_box_get_child_ipadding (GtkButtonBox *widget, gint *ipad_x, gint *ipad_y);
+
+(gtk-import-function nil gtk_button_box_set_spacing GtkButtonBox gint)
+(gtk-import-function nil gtk_button_box_set_layout GtkButtonBox GtkButtonBoxStyle)
+(gtk-import-function nil gtk_button_box_set_child_size GtkButtonBox gint gint)
+(gtk-import-function nil gtk_button_box_set_child_ipadding GtkButtonBox gint gint)
+
+\f
+(gtk-import-function GtkType gtk_calendar_get_type)
+(gtk-import-function GtkWidget gtk_calendar_new)
+(gtk-import-function gint gtk_calendar_select_month GtkCalendar guint guint)
+(gtk-import-function nil gtk_calendar_select_day GtkCalendar guint)
+(gtk-import-function gint gtk_calendar_mark_day GtkCalendar guint)
+(gtk-import-function gint gtk_calendar_unmark_day GtkCalendar guint)
+(gtk-import-function nil gtk_calendar_clear_marks GtkCalendar)
+(gtk-import-function nil gtk_calendar_display_options GtkCalendar GtkCalendarDisplayOptions)
+
+;Handcoded in ui-byhand.c... #### FIXME
+;void     gtk_calendar_get_date        (GtkCalendar *calendar, 
+;                                       guint       *year,
+;                                       guint       *month,
+;                                       guint       *day);
+
+(gtk-import-function nil gtk_calendar_freeze GtkCalendar)
+(gtk-import-function nil gtk_calendar_thaw GtkCalendar)
+
+\f
+(gtk-import-function GtkType gtk_check_button_get_type)
+(gtk-import-function GtkWidget gtk_check_button_new)
+(gtk-import-function GtkWidget gtk_check_button_new_with_label GtkString)
+
+\f
+(gtk-import-function GtkType gtk_check_menu_item_get_type)
+(gtk-import-function GtkWidget gtk_check_menu_item_new)
+(gtk-import-function GtkWidget gtk_check_menu_item_new_with_label GtkString)
+(gtk-import-function nil gtk_check_menu_item_set_active GtkCheckMenuItem gboolean)
+(gtk-import-function nil gtk_check_menu_item_set_show_toggle GtkCheckMenuItem gboolean)
+(gtk-import-function nil gtk_check_menu_item_toggled GtkCheckMenuItem)
+
+\f
+(gtk-import-function GtkType gtk_clist_get_type)
+(gtk-import-function GtkWidget gtk_clist_new gint)
+
+(gtk-import-function GtkWidget gtk_clist_new_with_titles
+                    (gint           . columns)
+                    (GtkArrayOfString . titles))
+
+;; set adjustments of clist
+(gtk-import-function nil gtk_clist_set_hadjustment GtkCList GtkAdjustment)
+(gtk-import-function nil gtk_clist_set_vadjustment GtkCList GtkAdjustment)
+
+;; get adjustments of clist
+(gtk-import-function GtkAdjustment gtk_clist_get_hadjustment GtkCList)
+(gtk-import-function GtkAdjustment gtk_clist_get_vadjustment GtkCList)
+
+;; set the border style of the clist
+(gtk-import-function nil gtk_clist_set_shadow_type GtkCList GtkShadowType)
+
+;; set the clist's selection mode
+(gtk-import-function nil gtk_clist_set_selection_mode GtkCList GtkSelectionMode)
+
+;; enable clists reorder ability
+(gtk-import-function nil gtk_clist_set_reorderable GtkCList gboolean)
+(gtk-import-function nil gtk_clist_set_use_drag_icons GtkCList gboolean)
+(gtk-import-function nil gtk_clist_set_button_actions GtkCList guint guint)
+
+;; freeze all visual updates of the list, and then thaw the list after
+;; you have made a number of changes and the updates wil occure in a
+;; more efficent mannor than if you made them on a unfrozen list
+(gtk-import-function nil gtk_clist_freeze GtkCList)
+(gtk-import-function nil gtk_clist_thaw GtkCList)
+
+;; show and hide the column title buttons
+(gtk-import-function nil gtk_clist_column_titles_show GtkCList)
+(gtk-import-function nil gtk_clist_column_titles_hide GtkCList)
+
+;; set the column title to be a active title (responds to button presses, 
+;; prelights, and grabs keyboard focus), or passive where it acts as just
+;; a title
+(gtk-import-function nil gtk_clist_column_title_active GtkCList gint)
+(gtk-import-function nil gtk_clist_column_title_passive GtkCList gint)
+(gtk-import-function nil gtk_clist_column_titles_active GtkCList)
+(gtk-import-function nil gtk_clist_column_titles_passive GtkCList)
+
+;; set the title in the column title button
+(gtk-import-function nil gtk_clist_set_column_title GtkCList gint GtkString)
+
+;; returns the title of column. Returns NULL if title is not set */
+(gtk-import-function GtkString gtk_clist_get_column_title GtkCList gint)
+
+;; set a widget instead of a title for the column title button
+(gtk-import-function nil gtk_clist_set_column_widget GtkCList gint GtkWidget)
+
+;; returns the column widget
+(gtk-import-function GtkWidget gtk_clist_get_column_widget GtkCList gint)
+
+;; set the justification on a column
+(gtk-import-function nil gtk_clist_set_column_justification GtkCList gint GtkJustification)
+
+;; set visibility of a column
+(gtk-import-function nil gtk_clist_set_column_visibility GtkCList gint gboolean)
+
+;; enable/disable column resize operations by mouse
+(gtk-import-function nil gtk_clist_set_column_resizeable GtkCList gint gboolean)
+
+;; resize column automatically to its optimal width
+(gtk-import-function nil gtk_clist_set_column_auto_resize GtkCList gint gboolean)
+(gtk-import-function gint gtk_clist_columns_autosize GtkCList)
+
+;; return the optimal column width, i.e. maximum of all cell widths
+(gtk-import-function gint gtk_clist_optimal_column_width GtkCList gint)
+
+;; set the pixel width of a column; this is a necessary step in
+;; creating a CList because otherwise the column width is chozen from
+;; the width of the column title, which will never be right
+
+(gtk-import-function nil gtk_clist_set_column_width GtkCList gint gint)
+
+;; set column minimum/maximum width. min/max_width < 0 => no restriction
+(gtk-import-function nil gtk_clist_set_column_min_width GtkCList gint gint)
+(gtk-import-function nil gtk_clist_set_column_max_width GtkCList gint gint)
+
+;; change the height of the rows, the default (height=0) is
+;; the hight of the current font.
+(gtk-import-function nil gtk_clist_set_row_height GtkCList guint)
+
+;; scroll the viewing area of the list to the given column and row;
+;; row_align and col_align are between 0-1 representing the location the
+;; row should appear on the screnn, 0.0 being top or left, 1.0 being
+;; bottom or right; if row or column is -1 then then there is no change
+(gtk-import-function nil gtk_clist_moveto GtkCList gint gint gfloat gfloat)
+
+;; returns whether the row is visible
+(gtk-import-function GtkVisibility gtk_clist_row_is_visible GtkCList gint)
+
+;; returns the cell type
+(gtk-import-function GtkCellType gtk_clist_get_cell_type GtkCList gint gint)
+
+;; sets a given cell's text, replacing it's current contents
+(gtk-import-function nil gtk_clist_set_text GtkCList gint gint GtkString)
+
+;; for the "get" functions, any of the return pointer can be
+;; NULL if you are not interested
+;;
+;;;Handcoded in ui-byhand.c... #### FIXME
+;;;gint gtk_clist_get_text (GtkCList  *clist,
+;;;                     gint       row,
+;;;                     gint       column,
+;;;                     gchar    **text);
+
+;; #### BILL!!! Implement these!
+;; (gtk-import-function nil gtk_clist_get_pixmap)
+;; (gtk-import-function nil gtk_clist_get_pixtext)
+
+(gtk-import-function nil gtk_clist_set_pixmap
+                    (GtkCList . clist)
+                    (gint     . row)
+                    (gint     . column)
+                    (GdkPixmap . pixmap)
+                    (GdkBitmap . mask))
+(gtk-import-function nil gtk_clist_set_pixtext
+                    (GtkCList . clist)
+                    (gint     . row)
+                    (gint     . column)
+                    (GtkString . text)
+                    (gint      . spacing)
+                    (GdkPixmap . pixmap)
+                    (GdkBitmap . mask))
+
+;; sets the foreground color of a row, the color must already
+;; be allocated
+(gtk-import-function nil gtk_clist_set_foreground GtkCList gint GdkColor)
+
+;; sets the background color of a row, the color must already
+;; be allocated
+(gtk-import-function nil gtk_clist_set_background GtkCList gint GdkColor)
+
+;; set / get cell styles
+(gtk-import-function nil gtk_clist_set_cell_style GtkCList gint gint GtkStyle)
+(gtk-import-function GtkStyle gtk_clist_get_cell_style GtkCList gint gint)
+(gtk-import-function nil gtk_clist_set_row_style GtkCList gint GtkStyle)
+(gtk-import-function GtkStyle gtk_clist_get_row_style GtkCList gint)
+
+;; this sets a horizontal and vertical shift for drawing
+;; the contents of a cell; it can be positive or negitive;
+;; this is particulary useful for indenting items in a column
+(gtk-import-function nil gtk_clist_set_shift GtkCList gint gint gint gint)
+
+;; set/get selectable flag of a single row
+(gtk-import-function nil gtk_clist_set_selectable GtkCList gint gboolean)
+(gtk-import-function gboolean gtk_clist_get_selectable GtkCList gint)
+
+;; prepend/append returns the index of the row you just added,
+;; making it easier to append and modify a row
+
+(gtk-import-function gint gtk_clist_prepend
+                    (GtkCList         . clist)
+                    (GtkArrayOfString . text))
+
+(gtk-import-function gint gtk_clist_append
+                    (GtkCList         . clist)
+                    (GtkArrayOfString . text))
+
+;; inserts a row at index row and returns the row where it was
+;; actually inserted (may be different from "row" in auto_sort mode)
+(gtk-import-function gint gtk_clist_insert
+                    (GtkCList . clist)
+                    (gint     . row)
+                    (GtkArrayOfString . text))
+
+;; removes row at index row
+(gtk-import-function nil gtk_clist_remove GtkCList gint)
+
+;; sets a arbitrary data pointer for a given row
+(gtk-import-function nil gtk_clist_set_row_data GtkCList gint gpointer)
+
+;; sets a data pointer for a given row with destroy notification
+;; #### Need to handle callbacks.
+;;;void gtk_clist_set_row_data_full (GtkCList         *clist,
+;;;                              gint              row,
+;;;                              gpointer          data,
+;;;                              GtkDestroyNotify  destroy);
+
+;; returns the data set for a row
+(gtk-import-function gpointer gtk_clist_get_row_data GtkCList gint)
+
+;; givin a data pointer, find the first (and hopefully only!)
+;; row that points to that data, or -1 if none do
+(gtk-import-function gint gtk_clist_find_row_from_data GtkCList gpointer)
+
+;; force selection of a row
+(gtk-import-function nil gtk_clist_select_row GtkCList gint gint)
+
+;; force unselection of a row
+(gtk-import-function nil gtk_clist_unselect_row GtkCList gint gint)
+
+;; undo the last select/unselect operation
+(gtk-import-function nil gtk_clist_undo_selection GtkCList)
+
+;; clear the entire list -- this is much faster than removing
+;; each item with gtk_clist_remove
+(gtk-import-function nil gtk_clist_clear GtkCList)
+
+;; return the row column corresponding to the x and y coordinates,
+;; the returned values are only valid if the x and y coordinates
+;; are respectively to a window == clist->clist_window
+;;
+;;;Handcoded in ui-byhand.c... #### FIXME
+;;;gint gtk_clist_get_selection_info (GtkCList *clist,
+;;;                               gint      x,
+;;;                               gint      y,
+;;;                               gint     *row,
+;;;                               gint     *column);
+
+;; in multiple or extended mode, select all rows
+(gtk-import-function nil gtk_clist_select_all GtkCList)
+
+;; in all modes except browse mode, deselect all rows
+(gtk-import-function nil gtk_clist_unselect_all GtkCList)
+
+;; swap the position of two rows
+(gtk-import-function nil gtk_clist_swap_rows GtkCList gint gint)
+
+;; move row from source_row position to dest_row position
+(gtk-import-function nil gtk_clist_row_move GtkCList gint gint)
+
+;; sets a compare function different to the default
+;;;void gtk_clist_set_compare_func (GtkCList            *clist,
+;;;                             GtkCListCompareFunc  cmp_func);
+
+;; the column to sort by
+(gtk-import-function nil gtk_clist_set_sort_column GtkCList gint)
+
+;; how to sort : ascending or descending
+(gtk-import-function nil gtk_clist_set_sort_type GtkCList GtkSortType)
+
+;; sort the list with the current compare function
+(gtk-import-function nil gtk_clist_sort GtkCList)
+
+;; Automatically sort upon insertion
+(gtk-import-function nil gtk_clist_set_auto_sort GtkCList gboolean)
+                    
+\f
+;; ColorSelection
+
+(gtk-import-function GtkType gtk_color_selection_get_type)
+(gtk-import-function GtkWidget gtk_color_selection_new)
+(gtk-import-function nil gtk_color_selection_set_update_policy GtkColorSelection GtkUpdateType)
+(gtk-import-function nil gtk_color_selection_set_opacity GtkColorSelection gint)
+(gtk-import-function nil gtk_color_selection_set_color GtkColorSelection gdouble)
+
+;;;Handcoded in ui-byhand.c... #### FIXME
+;void       gtk_color_selection_get_color         (GtkColorSelection     *colorsel,
+;                                                  gdouble               *color);
+
+;; ColorSelectionDialog
+(gtk-import-function GtkType gtk_color_selection_dialog_get_type)
+(gtk-import-function GtkWidget gtk_color_selection_dialog_new GtkString)
+
+\f
+(gtk-import-function GtkType gtk_combo_get_type)
+(gtk-import-function GtkWidget gtk_combo_new)
+
+;; the text in the entry must be or not be in the list
+(gtk-import-function nil gtk_combo_set_value_in_list GtkCombo gint gint)
+
+;; set/unset arrows working for changing the value (can be annoying)
+(gtk-import-function nil gtk_combo_set_use_arrows GtkCombo gint)
+
+;; up/down arrows change value if current value not in list
+(gtk-import-function nil gtk_combo_set_use_arrows_always GtkCombo gint)
+
+;; perform case-sensitive compares
+(gtk-import-function nil gtk_combo_set_case_sensitive GtkCombo gint)
+
+;; call this function on an item if it isn't a label or you
+;; want it to have a different value to be displayed in the entry
+(gtk-import-function nil gtk_combo_set_item_string GtkCombo GtkItem GtkString)
+
+(gtk-import-function nil gtk_combo_set_popdown_strings
+                    (GtkCombo . combo)
+                    (GtkListOfString . strings))
+
+(gtk-import-function nil gtk_combo_disable_activate GtkCombo)
+
+\f
+(gtk-import-function GtkType gtk_container_get_type)
+(gtk-import-function nil gtk_container_set_border_width GtkContainer guint)
+(gtk-import-function nil gtk_container_add GtkContainer GtkWidget)
+(gtk-import-function nil gtk_container_remove GtkContainer GtkWidget)
+(gtk-import-function nil gtk_container_set_resize_mode GtkContainer GtkResizeMode)
+(gtk-import-function nil gtk_container_check_resize GtkContainer)
+
+;; You can emulate this with (mapcar (lambda (x) ..) (gtk-container-children))
+
+;;(gtk-import-function nil gtk_container_foreach GtkContainer GtkCallback)
+
+; I don't think we really want to deal with this... ever.  #### FIXME?
+;void    gtk_container_foreach_full     (GtkContainer     *container,
+;                                        GtkCallback       callback,
+;                                        GtkCallbackMarshal marshal,
+;                                        gpointer          callback_data,
+;                                        GtkDestroyNotify  notify);
+
+(gtk-import-function GtkListOfObject gtk_container_children
+                    (GtkContainer . container))
+
+(gtk-import-function gint gtk_container_focus GtkContainer GtkDirectionType)
+
+;;; Widget-level methods
+(gtk-import-function nil gtk_container_set_reallocate_redraws GtkContainer gboolean)
+(gtk-import-function nil gtk_container_set_focus_child GtkContainer GtkWidget)
+(gtk-import-function nil gtk_container_set_focus_vadjustment GtkContainer GtkAdjustment)
+(gtk-import-function nil gtk_container_set_focus_hadjustment GtkContainer GtkAdjustment)
+(gtk-import-function nil gtk_container_register_toplevel GtkContainer)
+(gtk-import-function nil gtk_container_unregister_toplevel GtkContainer)
+
+(gtk-import-function GtkListOfObject gtk_container_get_toplevels)
+
+(gtk-import-function nil gtk_container_resize_children GtkContainer)
+(gtk-import-function guint gtk_container_child_type GtkContainer)
+
+; the `arg_name' argument needs to be a const static string */
+;void    gtk_container_add_child_arg_type   (const gchar      *arg_name,
+;                                          GtkType           arg_type,
+;                                          guint             arg_flags,
+;                                          guint             arg_id);
+     
+;/* Allocate a GtkArg array of size nargs that hold the
+; * names and types of the args that can be used with
+; * gtk_container_child_getv/gtk_container_child_setv.
+; * if (arg_flags!=NULL),
+; * (*arg_flags) will be set to point to a newly allocated
+; * guint array that holds the flags of the args.
+; * It is the callers response to do a
+; * g_free (returned_args); g_free (*arg_flags).
+; */
+;GtkArg* gtk_container_query_child_args           (GtkType            class_type,
+;                                          guint32          **arg_flags,
+;                                          guint             *nargs);
+
+;/* gtk_container_child_getv() sets an arguments type and value, or just
+; * its type to GTK_TYPE_INVALID.
+; * if GTK_FUNDAMENTAL_TYPE (arg->type) == GTK_TYPE_STRING, it's the callers
+; * response to do a g_free (GTK_VALUE_STRING (arg));
+; */
+;void    gtk_container_child_getv         (GtkContainer      *container,
+;                                          GtkWidget         *child,
+;                                          guint              n_args,
+;                                          GtkArg            *args);
+;void    gtk_container_child_setv         (GtkContainer      *container,
+;                                          GtkWidget         *child,
+;                                          guint              n_args,
+;                                          GtkArg            *args);
+
+;/* gtk_container_add_with_args() takes a variable argument list of the form:
+; * (..., gchar *arg_name, ARG_VALUES, [repeatedly name/value pairs,] NULL)
+; * where ARG_VALUES type depend on the argument and can consist of
+; * more than one c-function argument.
+; */
+;void    gtk_container_add_with_args      (GtkContainer      *container,
+;                                          GtkWidget         *widget,
+;                                          const gchar       *first_arg_name,
+;                                          ...);
+;void    gtk_container_addv               (GtkContainer      *container,
+;                                          GtkWidget         *widget,
+;                                          guint              n_args,
+;                                          GtkArg            *args);
+;void  gtk_container_child_set            (GtkContainer      *container,
+;                                          GtkWidget         *child,
+;                                          const gchar       *first_arg_name,
+;                                          ...);
+
+\f
+(gtk-import-function GtkType gtk_curve_get_type)
+(gtk-import-function GtkWidget gtk_curve_new)
+(gtk-import-function nil gtk_curve_reset GtkCurve)
+(gtk-import-function nil gtk_curve_set_gamma GtkCurve gfloat)
+(gtk-import-function nil gtk_curve_set_range GtkCurve gfloat gfloat gfloat gfloat)
+
+;Handcoded in ui-byhand.c... #### FIXME
+;;void         gtk_curve_get_vector    (GtkCurve *curve,
+;;                                      int veclen, gfloat vector[]);
+;;
+;;void         gtk_curve_set_vector    (GtkCurve *curve,
+;;                                      int veclen, gfloat vector[]);
+
+(gtk-import-function nil gtk_curve_set_curve_type GtkCurve GtkCurveType)
+
+\f
+(gtk-import-function GtkType gtk_data_get_type)
+
+\f
+(gtk-import-function GtkType gtk_dialog_get_type)
+(gtk-import-function GtkWidget gtk_dialog_new)
+
+\f
+(gtk-import-function GtkType gtk_drawing_area_get_type)
+(gtk-import-function GtkWidget gtk_drawing_area_new)
+(gtk-import-function nil gtk_drawing_area_size GtkDrawingArea gint gint)
+
+\f
+(gtk-import-function GtkType gtk_editable_get_type)
+(gtk-import-function nil gtk_editable_select_region GtkEditable gint gint)
+
+;;;Handcoded in ui-byhand.c... #### FIXME
+;;;(gtk-import-function nil gtk_editable_insert_text GtkEditable GtkString gint pointer-to-gint)
+
+(gtk-import-function nil gtk_editable_delete_text GtkEditable gint gint)
+(gtk-import-function GtkString gtk_editable_get_chars GtkEditable gint gint)
+(gtk-import-function nil gtk_editable_cut_clipboard GtkEditable)
+(gtk-import-function nil gtk_editable_copy_clipboard GtkEditable)
+(gtk-import-function nil gtk_editable_paste_clipboard GtkEditable)
+(gtk-import-function nil gtk_editable_claim_selection GtkEditable gboolean guint)
+(gtk-import-function nil gtk_editable_delete_selection GtkEditable)
+(gtk-import-function nil gtk_editable_changed GtkEditable)
+(gtk-import-function nil gtk_editable_set_position GtkEditable gint)
+(gtk-import-function gint gtk_editable_get_position GtkEditable)
+(gtk-import-function nil gtk_editable_set_editable GtkEditable gboolean)
+
+\f
+(gtk-import-function GtkType gtk_entry_get_type)
+(gtk-import-function GtkWidget gtk_entry_new)
+(gtk-import-function GtkWidget gtk_entry_new_with_max_length guint)
+(gtk-import-function nil gtk_entry_set_text GtkEntry GtkString)
+(gtk-import-function nil gtk_entry_append_text GtkEntry GtkString)
+(gtk-import-function nil gtk_entry_prepend_text GtkEntry GtkString)
+(gtk-import-function nil gtk_entry_set_position GtkEntry gint)
+
+;; returns a reference to the text
+(gtk-import-function GtkString gtk_entry_get_text GtkEntry)
+(gtk-import-function nil gtk_entry_select_region GtkEntry gint gint)
+(gtk-import-function nil gtk_entry_set_visibility GtkEntry gboolean)
+(gtk-import-function nil gtk_entry_set_editable GtkEntry gboolean)
+
+;; text is truncated if needed
+(gtk-import-function nil gtk_entry_set_max_length GtkEntry guint)
+
+\f
+(gtk-import-function GtkType gtk_event_box_get_type)
+(gtk-import-function GtkWidget gtk_event_box_new)
+
+\f
+(gtk-import-function GtkType gtk_file_selection_get_type)
+(gtk-import-function GtkWidget gtk_file_selection_new GtkString)
+(gtk-import-function nil gtk_file_selection_set_filename GtkFileSelection GtkString)
+(gtk-import-function GtkString gtk_file_selection_get_filename GtkFileSelection)
+(gtk-import-function nil gtk_file_selection_complete GtkFileSelection GtkString)
+(gtk-import-function nil gtk_file_selection_show_fileop_buttons GtkFileSelection)
+(gtk-import-function nil gtk_file_selection_hide_fileop_buttons GtkFileSelection)
+
+\f
+(gtk-import-function GtkType gtk_fixed_get_type)
+(gtk-import-function GtkWidget gtk_fixed_new)
+(gtk-import-function nil gtk_fixed_put GtkFixed GtkWidget gint gint)
+(gtk-import-function nil gtk_fixed_move  GtkFixed GtkWidget gint gint)
+
+\f
+(gtk-import-function GtkType gtk_font_selection_get_type)
+(gtk-import-function GtkWidget gtk_font_selection_new)
+(gtk-import-function GtkString gtk_font_selection_get_font_name GtkFontSelection)
+;(gtk-import-function GdkFont gtk_font_selection_get_font GtkFontSelection)
+(gtk-import-function gboolean gtk_font_selection_set_font_name GtkFontSelection GtkString)
+
+
+(gtk-import-function nil gtk_font_selection_set_filter
+                    (GtkFontSelection  . fontsel)
+                    (GtkFontFilterType . filter_type)
+                    (GtkFontType       . font_type)
+                    (GtkArrayOfString  . foundries)
+                    (GtkArrayOfString  . weights)
+                    (GtkArrayOfString  . slants)
+                    (GtkArrayOfString  . setwidths)
+                    (GtkArrayOfString  . spacings)
+                    (GtkArrayOfString  . charsets))
+
+(gtk-import-function GtkString gtk_font_selection_get_preview_text GtkFontSelection)
+(gtk-import-function nil gtk_font_selection_set_preview_text GtkFontSelection GtkString)
+
+;; GtkFontSelectionDialog functions.
+;;   most of these functions simply call the corresponding function in the
+;;   GtkFontSelection.
+
+(gtk-import-function GtkType gtk_font_selection_dialog_get_type)
+(gtk-import-function GtkWidget gtk_font_selection_dialog_new GtkString)
+
+;; This returns the X Logical Font Description fontname, or NULL if no font
+;; is selected. Note that there is a slight possibility that the font might not
+;; have been loaded OK. You should call gtk_font_selection_dialog_get_font()
+;; to see if it has been loaded OK.
+(gtk-import-function GtkString gtk_font_selection_dialog_get_font_name GtkFontSelectionDialog)
+
+;; This will return the current GdkFont, or NULL if none is selected or there
+;; was a problem loading it. Remember to use gdk_font_ref/unref() if you want
+;; to use the font (in a style, for example)
+;; GdkFont* gtk_font_selection_dialog_get_font     (GtkFontSelectionDialog *fsd);
+
+;; This sets the currently displayed font. It should be a valid X Logical
+;; Font Description font name (anything else will be ignored), e.g.
+;; "-adobe-courier-bold-o-normal--25-*-*-*-*-*-*-*" 
+;; It returns TRUE on success.
+(gtk-import-function gboolean gtk_font_selection_dialog_set_font_name GtkFontSelectionDialog GtkString)
+
+;; This sets one of the font filters, to limit the fonts shown. The filter_type
+;; is GTK_FONT_FILTER_BASE or GTK_FONT_FILTER_USER. The font type is a
+;; combination of the bit flags GTK_FONT_BITMAP, GTK_FONT_SCALABLE and
+;; GTK_FONT_SCALABLE_BITMAP (or GTK_FONT_ALL for all font types).
+;; The foundries, weights etc. are arrays of strings containing property
+;; values, e.g. 'bold', 'demibold', and *MUST* finish with a NULL.
+;; Standard long names are also accepted, e.g. 'italic' instead of 'i'.
+;;
+;; e.g. to allow only fixed-width fonts ('char cell' or 'monospaced') to be
+;; selected use:
+;;
+;;gchar *spacings[] = { "c", "m", NULL };
+;;gtk_font_selection_dialog_set_filter (GTK_FONT_SELECTION_DIALOG (fontsel),
+;;                                    GTK_FONT_FILTER_BASE, GTK_FONT_ALL,
+;;                                    NULL, NULL, NULL, NULL, spacings, NULL);
+;;
+;;  to allow only true scalable fonts to be selected use:
+;;
+;;  gtk_font_selection_dialog_set_filter (GTK_FONT_SELECTION_DIALOG (fontsel),
+;;                                    GTK_FONT_FILTER_BASE, GTK_FONT_SCALABLE,
+;;                                    NULL, NULL, NULL, NULL, NULL, NULL);
+
+;;; #### BILL!!! You can do this by just call
+;;; gtk_font_selection_set_filter on the appropriate slot of the
+;;; dialog.  Why bother with another function?
+;;;void           gtk_font_selection_dialog_set_filter (GtkFontSelectionDialog *fsd,
+;;;                                             GtkFontFilterType filter_type,
+;;;                                             GtkFontType       font_type,
+;;;                                             gchar           **foundries,
+;;;                                             gchar           **weights,
+;;;                                             gchar           **slants,
+;;;                                             gchar           **setwidths,
+;;;                                             gchar           **spacings,
+;;;                                             gchar           **charsets);
+
+;; This returns the text in the preview entry.
+(gtk-import-function GtkString gtk_font_selection_dialog_get_preview_text GtkFontSelectionDialog)
+
+;; This sets the text in the preview entry. It will be copied by the entry,
+;; so there's no need to g_strdup() it first.
+(gtk-import-function nil gtk_font_selection_dialog_set_preview_text GtkFontSelectionDialog GtkString)
+
+\f
+(gtk-import-function GtkType gtk_frame_get_type)
+(gtk-import-function GtkWidget gtk_frame_new GtkString)
+(gtk-import-function nil gtk_frame_set_label GtkFrame GtkString)
+(gtk-import-function nil gtk_frame_set_label_align GtkFrame gfloat gfloat)
+(gtk-import-function nil gtk_frame_set_shadow_type GtkFrame GtkShadowType)
+
+\f
+(gtk-import-function GtkType gtk_gamma_curve_get_type)
+(gtk-import-function GtkWidget gtk_gamma_curve_new)
+
+\f
+(gtk-import-function GtkType gtk_handle_box_get_type)
+(gtk-import-function GtkWidget gtk_handle_box_new)
+(gtk-import-function nil gtk_handle_box_set_shadow_type GtkHandleBox GtkShadowType)
+(gtk-import-function nil gtk_handle_box_set_handle_position GtkHandleBox GtkPositionType)
+(gtk-import-function nil gtk_handle_box_set_snap_edge GtkHandleBox GtkPositionType)
+
+\f
+(gtk-import-function GtkType gtk_hbox_get_type)
+(gtk-import-function GtkWidget gtk_hbox_new gboolean gint)
+
+\f
+(gtk-import-function GtkType gtk_hbutton_box_get_type)
+(gtk-import-function GtkWidget gtk_hbutton_box_new)
+
+;; buttons can be added by gtk_container_add()
+(gtk-import-function gint gtk_hbutton_box_get_spacing_default)
+(gtk-import-function nil gtk_hbutton_box_set_spacing_default gint)
+
+(gtk-import-function GtkButtonBoxStyle gtk_hbutton_box_get_layout_default)
+(gtk-import-function nil gtk_hbutton_box_set_layout_default GtkButtonBoxStyle)
+
+\f
+(gtk-import-function GtkType gtk_hpaned_get_type)
+(gtk-import-function GtkWidget gtk_hpaned_new)
+
+\f
+(gtk-import-function GtkType gtk_hruler_get_type)
+(gtk-import-function GtkWidget gtk_hruler_new)
+
+\f
+(gtk-import-function GtkType gtk_hscale_get_type)
+(gtk-import-function GtkWidget gtk_hscale_new GtkAdjustment)
+
+\f
+(gtk-import-function GtkType gtk_hscrollbar_get_type)
+(gtk-import-function GtkWidget gtk_hscrollbar_new GtkAdjustment)
+
+\f
+(gtk-import-function GtkType gtk_hseparator_get_type)
+(gtk-import-function GtkWidget gtk_hseparator_new)
+
+\f
+(gtk-import-function GtkType gtk_input_dialog_get_type)
+(gtk-import-function GtkWidget gtk_input_dialog_new)
+
+\f
+(gtk-import-function GtkType gtk_invisible_get_type)
+(gtk-import-function GtkWidget gtk_invisible_new)
+
+\f
+(gtk-import-function GtkType gtk_item_get_type)
+(gtk-import-function nil gtk_item_select GtkItem)
+(gtk-import-function nil gtk_item_deselect GtkItem)
+(gtk-import-function nil gtk_item_toggle GtkItem)
+
+\f
+(gtk-import-function GtkType gtk_label_get_type)
+(gtk-import-function GtkWidget gtk_label_new GtkString)
+(gtk-import-function nil gtk_label_set_text GtkLabel GtkString)
+(gtk-import-function nil gtk_label_set_justify GtkLabel GtkJustification)
+(gtk-import-function nil gtk_label_set_pattern GtkLabel GtkString)
+(gtk-import-function nil gtk_label_set_line_wrap GtkLabel gboolean)
+
+;;;Handcoded in ui-byhand.c... #### FIXME
+;void       gtk_label_get           (GtkLabel          *label,
+;                                    gchar            **str);
+
+;; Convenience function to set the name and pattern by parsing
+;; a string with embedded underscores, and return the appropriate
+;; key symbol for the accelerator.
+(gtk-import-function guint gtk_label_parse_uline GtkLabel GtkString)
+
+\f
+(gtk-import-function GtkType gtk_layout_get_type)
+(gtk-import-function GtkWidget gtk_layout_new GtkAdjustment GtkAdjustment)
+(gtk-import-function nil gtk_layout_put GtkLayout GtkWidget gint gint)
+(gtk-import-function nil gtk_layout_move GtkLayout GtkWidget gint gint)
+(gtk-import-function nil gtk_layout_set_size GtkLayout guint guint)
+
+(gtk-import-function GtkAdjustment gtk_layout_get_hadjustment GtkLayout)
+(gtk-import-function GtkAdjustment gtk_layout_get_vadjustment GtkLayout)
+(gtk-import-function nil gtk_layout_set_hadjustment GtkLayout GtkAdjustment)
+(gtk-import-function nil gtk_layout_set_vadjustment GtkLayout GtkAdjustment)
+
+;; These disable and enable moving and repainting the scrolling window
+;; of the GtkLayout, respectively.  If you want to update the layout's
+;; offsets but do not want it to repaint itself, you should use these
+;; functions.
+
+;; - I don't understand these are supposed to work, so I suspect
+;; - they don't now.                    OWT 1/20/98
+
+(gtk-import-function nil gtk_layout_freeze GtkLayout)
+(gtk-import-function nil gtk_layout_thaw GtkLayout)
+
+\f
+(gtk-import-function GtkType gtk_list_get_type)
+(gtk-import-function GtkWidget gtk_list_new)
+
+(gtk-import-function nil gtk_list_insert_items
+                    (GtkList         . list)
+                    (GtkListOfObject . items)
+                    (gint            . position))
+
+(gtk-import-function nil gtk_list_append_items
+                    (GtkList         . list)
+                    (GtkListOfObject . items))
+(gtk-import-function nil gtk_list_prepend_items
+                    (GtkList         . list)
+                    (GtkListOfObject . items))
+(gtk-import-function nil gtk_list_remove_items
+                    (GtkList         . list)
+                    (GtkListOfObject . items))
+(gtk-import-function nil gtk_list_remove_items_no_unref
+                    (GtkList         . list)
+                    (GtkListOfObject . items))
+
+(gtk-import-function nil gtk_list_clear_items GtkList gint gint)
+(gtk-import-function nil gtk_list_select_item GtkList gint)
+(gtk-import-function nil gtk_list_unselect_item GtkList gint)
+(gtk-import-function nil gtk_list_select_child GtkList GtkWidget)
+(gtk-import-function nil gtk_list_unselect_child GtkList GtkWidget)
+(gtk-import-function gint gtk_list_child_position GtkList GtkWidget)
+(gtk-import-function nil gtk_list_set_selection_mode GtkList GtkSelectionMode)
+(gtk-import-function nil gtk_list_extend_selection GtkList GtkScrollType gfloat gboolean)
+(gtk-import-function nil gtk_list_start_selection GtkList)
+(gtk-import-function nil gtk_list_end_selection GtkList)
+(gtk-import-function nil gtk_list_select_all GtkList)
+(gtk-import-function nil gtk_list_unselect_all GtkList)
+(gtk-import-function nil gtk_list_scroll_horizontal GtkList GtkScrollType gfloat)
+(gtk-import-function nil gtk_list_scroll_vertical GtkList  GtkScrollType gfloat)
+(gtk-import-function nil gtk_list_toggle_add_mode GtkList)
+(gtk-import-function nil gtk_list_toggle_focus_row GtkList)
+(gtk-import-function nil gtk_list_toggle_row GtkList GtkWidget)
+(gtk-import-function nil gtk_list_undo_selection GtkList)
+(gtk-import-function nil gtk_list_end_drag_selection GtkList)
+
+\f
+(gtk-import-function GtkType gtk_list_item_get_type)
+(gtk-import-function GtkWidget gtk_list_item_new)
+(gtk-import-function GtkWidget gtk_list_item_new_with_label GtkString)
+(gtk-import-function nil gtk_list_item_select GtkListItem)
+(gtk-import-function nil gtk_list_item_deselect GtkListItem)
+
+\f
+(gtk-import-variable guint gtk_major_version)
+(gtk-import-variable guint gtk_minor_version)
+(gtk-import-variable guint gtk_micro_version)
+(gtk-import-variable guint gtk_interface_age)
+(gtk-import-variable guint gtk_binary_age)
+
+(gtk-import-function GtkString gtk_check_version
+                    (guint . required_major)
+                    (guint . required_minor)
+                    (guint . required_micro))
+
+(gtk-import-function gboolean gtk_events_pending)
+(gtk-import-function guint gtk_main_level)
+(gtk-import-function nil gtk_main)
+(gtk-import-function nil gtk_main_quit)
+(gtk-import-function gint gtk_main_iteration)
+(gtk-import-function gint gtk_main_iteration_do (gboolean . blocking))
+(gtk-import-function gint gtk_true)
+(gtk-import-function gint gtk_false)
+
+\f
+(gtk-import-function GtkType gtk_menu_get_type)
+(gtk-import-function GtkWidget gtk_menu_new)
+
+;; Wrappers for the Menu Shell operations
+(gtk-import-function nil gtk_menu_append GtkMenu GtkWidget)
+(gtk-import-function nil gtk_menu_prepend GtkMenu GtkWidget)
+(gtk-import-function nil gtk_menu_insert GtkMenu GtkWidget gint)
+
+;; Display the menu onscreen
+(gtk-import-function nil gtk_menu_popup GtkMenu GtkWidget GtkWidget
+                    gpointer   ;; GtkMenuPositionFunc  func
+                    gpointer
+                    guint
+                    guint)
+
+;; Position the menu according to it's position function. Called
+;; from gtkmenuitem.c when a menu-item changes its allocation
+(gtk-import-function nil gtk_menu_reposition GtkMenu)
+(gtk-import-function nil gtk_menu_popdown GtkMenu)
+
+;; Keep track of the last menu item selected. (For the purposes
+;; of the option menu
+(gtk-import-function GtkWidget gtk_menu_get_active GtkMenu)
+(gtk-import-function nil gtk_menu_set_active GtkMenu guint)
+
+;; set/get the acclerator group that holds global accelerators (should
+;; be added to the corresponding toplevel with gtk_window_add_accel_group().
+(gtk-import-function nil gtk_menu_set_accel_group GtkMenu GtkAccelGroup)
+(gtk-import-function GtkAccelGroup gtk_menu_get_accel_group GtkMenu)
+
+;; get the accelerator group that is used internally by the menu for
+;; underline accelerators while the menu is popped up.
+(gtk-import-function GtkAccelGroup gtk_menu_get_uline_accel_group GtkMenu)
+(gtk-import-function GtkAccelGroup gtk_menu_ensure_uline_accel_group GtkMenu)
+
+;; A reference count is kept for a widget when it is attached to
+;; a particular widget. This is typically a menu item; it may also
+;; be a widget with a popup menu - for instance, the Notebook widget.
+(gtk-import-function nil gtk_menu_attach_to_widget GtkMenu GtkWidget gpointer)
+(gtk-import-function nil gtk_menu_detach GtkMenu)
+
+;; This should be dumped in favor of data set when the menu is popped
+;; up - that is currently in the ItemFactory code, but should be
+;; in the Menu code.
+(gtk-import-function GtkWidget gtk_menu_get_attach_widget GtkMenu)
+(gtk-import-function nil gtk_menu_set_tearoff_state GtkMenu gboolean)
+
+;; This sets the window manager title for the window that
+;; appears when a menu is torn off
+(gtk-import-function nil gtk_menu_set_title GtkMenu GtkString)
+
+(gtk-import-function nil gtk_menu_reorder_child GtkMenu GtkWidget gint)
+
+\f
+(gtk-import-function GtkType gtk_menu_bar_get_type)
+(gtk-import-function GtkWidget gtk_menu_bar_new)
+(gtk-import-function nil gtk_menu_bar_append GtkMenuBar GtkWidget)
+(gtk-import-function nil gtk_menu_bar_prepend GtkMenuBar GtkWidget)
+(gtk-import-function nil gtk_menu_bar_insert GtkMenuBar GtkWidget gint)
+(gtk-import-function nil gtk_menu_bar_set_shadow_type GtkMenuBar GtkShadowType)
+
+\f
+(gtk-import-function GtkType gtk_menu_item_get_type)
+(gtk-import-function GtkWidget gtk_menu_item_new)
+(gtk-import-function GtkWidget gtk_menu_item_new_with_label GtkString)
+(gtk-import-function nil gtk_menu_item_set_submenu GtkMenuItem GtkWidget)
+(gtk-import-function nil gtk_menu_item_remove_submenu GtkMenuItem)
+(gtk-import-function nil gtk_menu_item_set_placement GtkMenuItem GtkSubmenuPlacement)
+(gtk-import-function nil gtk_menu_item_configure GtkMenuItem gint gint)
+(gtk-import-function nil gtk_menu_item_select GtkMenuItem)
+(gtk-import-function nil gtk_menu_item_deselect GtkMenuItem)
+(gtk-import-function nil gtk_menu_item_activate GtkMenuItem)
+(gtk-import-function nil gtk_menu_item_right_justify GtkMenuItem)
+
+\f
+(gtk-import-function GtkType gtk_misc_get_type)
+(gtk-import-function nil gtk_misc_set_alignment
+                    (GtkMisc . misc)
+                    (gfloat  . xalign)
+                    (gfloat  . yalign))
+
+(gtk-import-function nil gtk_misc_set_padding
+                    (GtkMisc . misc)
+                    (gint    . xpad)
+                    (gint    . ypad))
+
+\f
+(gtk-import-function GtkType gtk_notebook_get_type)
+(gtk-import-function GtkWidget gtk_notebook_new)
+(gtk-import-function nil gtk_notebook_append_page GtkNotebook GtkWidget GtkWidget)
+(gtk-import-function nil gtk_notebook_append_page_menu GtkNotebook GtkWidget GtkWidget GtkWidget)
+(gtk-import-function nil gtk_notebook_prepend_page GtkNotebook GtkWidget GtkWidget)
+(gtk-import-function nil gtk_notebook_prepend_page_menu GtkNotebook GtkWidget GtkWidget GtkWidget)
+(gtk-import-function nil gtk_notebook_insert_page GtkNotebook GtkWidget GtkWidget gint)
+(gtk-import-function nil gtk_notebook_insert_page_menu GtkNotebook GtkWidget GtkWidget GtkWidget gint)
+(gtk-import-function nil gtk_notebook_remove_page GtkNotebook gint)
+
+;;query, set current NoteebookPage
+(gtk-import-function gint gtk_notebook_get_current_page GtkNotebook)
+(gtk-import-function GtkWidget gtk_notebook_get_nth_page GtkNotebook gint)
+(gtk-import-function gint gtk_notebook_page_num GtkNotebook GtkWidget)
+(gtk-import-function nil gtk_notebook_set_page GtkNotebook gint)
+(gtk-import-function nil gtk_notebook_next_page GtkNotebook)
+(gtk-import-function nil gtk_notebook_prev_page GtkNotebook)
+
+;; set Notebook, NotebookTab style
+(gtk-import-function nil gtk_notebook_set_show_border GtkNotebook gboolean)
+(gtk-import-function nil gtk_notebook_set_show_tabs GtkNotebook gboolean)
+(gtk-import-function nil gtk_notebook_set_tab_pos GtkNotebook GtkPositionType)
+(gtk-import-function nil gtk_notebook_set_homogeneous_tabs GtkNotebook gboolean)
+(gtk-import-function nil gtk_notebook_set_tab_border GtkNotebook guint)
+(gtk-import-function nil gtk_notebook_set_tab_hborder GtkNotebook guint)
+(gtk-import-function nil gtk_notebook_set_tab_vborder GtkNotebook guint)
+(gtk-import-function nil gtk_notebook_set_scrollable GtkNotebook gboolean)
+
+;; enable/disable PopupMenu
+(gtk-import-function nil gtk_notebook_popup_enable GtkNotebook)
+(gtk-import-function nil gtk_notebook_popup_disable GtkNotebook)
+
+;; query/set NotebookPage Properties
+(gtk-import-function GtkWidget gtk_notebook_get_tab_label GtkNotebook GtkWidget)
+(gtk-import-function nil gtk_notebook_set_tab_label GtkNotebook GtkWidget GtkWidget)
+(gtk-import-function nil gtk_notebook_set_tab_label_text GtkNotebook GtkWidget GtkString)
+(gtk-import-function GtkWidget gtk_notebook_get_menu_label GtkNotebook GtkWidget)
+(gtk-import-function nil gtk_notebook_set_menu_label GtkNotebook GtkWidget GtkWidget)
+(gtk-import-function nil gtk_notebook_set_menu_label_text GtkNotebook GtkWidget GtkString)
+
+;;;Handcoded in ui-byhand.c... #### FIXME
+;;;void gtk_notebook_query_tab_label_packing (GtkNotebook *notebook,
+;;;                                       GtkWidget   *child,
+;;;                                       gboolean    *expand,
+;;;                                       gboolean    *fill,
+;;;                                       GtkPackType *pack_type);
+(gtk-import-function nil gtk_notebook_set_tab_label_packing GtkNotebook GtkWidget gboolean gboolean GtkPackType)
+
+(gtk-import-function nil gtk_notebook_reorder_child GtkNotebook GtkWidget gint)
+
+\f
+(gtk-import-function GtkType gtk_object_get_type)
+;(gtk-import-function 'GtkObject gtk_object_newv 'guint 'guint 'GtkArg)
+(gtk-import-function nil gtk_object_sink GtkObject)
+(gtk-import-function nil gtk_object_ref GtkObject)
+(gtk-import-function nil gtk_object_unref GtkObject)
+
+;; Need to implement callbacks better before I can do this.
+;;void gtk_object_weakref        (GtkObject        *object,
+;;                        GtkDestroyNotify  notify,
+;;                        gpointer          data);
+;;void gtk_object_weakunref (GtkObject     *object,
+;;                        GtkDestroyNotify  notify,
+;;                        gpointer          data);
+
+(gtk-import-function nil gtk_object_destroy GtkObject)
+
+;; gtk_object_[gs]etv* () are handled by our generic 'get' and 'put'
+;; handlers for types of GtkObject
+
+\f
+(gtk-import-function GtkType gtk_option_menu_get_type)
+(gtk-import-function GtkWidget gtk_option_menu_new)
+(gtk-import-function GtkWidget gtk_option_menu_get_menu GtkOptionMenu)
+(gtk-import-function nil gtk_option_menu_set_menu GtkOptionMenu GtkWidget)
+(gtk-import-function nil gtk_option_menu_remove_menu GtkOptionMenu)
+(gtk-import-function nil gtk_option_menu_set_history GtkOptionMenu guint)
+
+\f
+(gtk-import-function GtkType gtk_packer_get_type)
+(gtk-import-function GtkWidget gtk_packer_new)
+(gtk-import-function nil gtk_packer_add_defaults GtkPacker GtkWidget
+                    GtkSideType GtkAnchorType GtkPackerOptions)
+(gtk-import-function nil gtk_packer_add GtkPacker
+                    GtkWidget
+                    GtkSideType
+                    GtkAnchorType
+                    GtkPackerOptions
+                    guint
+                    guint
+                    guint
+                    guint
+                    guint)
+
+(gtk-import-function nil gtk_packer_set_child_packing GtkPacker
+                    GtkWidget
+                    GtkSideType
+                    GtkAnchorType
+                    GtkPackerOptions
+                    guint
+                    guint
+                    guint
+                    guint
+                    guint)
+
+(gtk-import-function nil gtk_packer_reorder_child GtkPacker GtkWidget gint)
+(gtk-import-function nil gtk_packer_set_spacing GtkPacker guint)
+(gtk-import-function nil gtk_packer_set_default_border_width GtkPacker guint)
+(gtk-import-function nil gtk_packer_set_default_pad GtkPacker guint guint)
+(gtk-import-function nil gtk_packer_set_default_ipad GtkPacker guint guint)
+
+\f
+(gtk-import-function GtkType gtk_paned_get_type)
+(gtk-import-function nil gtk_paned_add1 GtkPaned GtkWidget)
+(gtk-import-function nil gtk_paned_add2 GtkPaned GtkWidget)
+(gtk-import-function nil gtk_paned_pack1 GtkPaned GtkWidget gboolean gboolean)
+(gtk-import-function nil gtk_paned_pack2 GtkPaned GtkWidget gboolean gboolean)
+(gtk-import-function nil gtk_paned_set_position GtkPaned gint)
+(gtk-import-function nil gtk_paned_set_handle_size GtkPaned guint)
+(gtk-import-function nil gtk_paned_set_gutter_size GtkPaned guint)
+
+;; Internal function... do we need to expose this?
+(gtk-import-function nil gtk_paned_compute_position GtkPaned gint gint gint)
+
+\f
+(gtk-import-function GtkType gtk_pixmap_get_type)
+(gtk-import-function GtkWidget gtk_pixmap_new
+                    (GdkPixmap . pixmap)
+                    (GdkPixmap . mask))
+(gtk-import-function nil gtk_pixmap_set
+                    (GtkPixmap . object)
+                    (GdkPixmap . pixmap)
+                    (GdkPixmap . mask))
+
+;Handcoded in ui-byhand.c... #### FIXME
+;;;void           gtk_pixmap_get        (GtkPixmap  *pixmap,
+;;;                              GdkPixmap **val,
+;;;                              GdkBitmap **mask);
+
+(gtk-import-function nil gtk_pixmap_set_build_insensitive
+                    (GtkPixmap . pixmap)
+                    (guint     . build))
+
+\f
+(gtk-import-function GtkType gtk_plug_get_type)
+(gtk-import-function GtkWidget gtk_plug_new guint)
+(gtk-import-function nil gtk_plug_construct GtkPlug guint)
+
+\f
+(gtk-import-function GtkType gtk_progress_get_type)
+(gtk-import-function nil gtk_progress_set_show_text GtkProgress gint)
+(gtk-import-function nil gtk_progress_set_text_alignment GtkProgress gfloat gfloat)
+(gtk-import-function nil gtk_progress_set_format_string GtkProgress GtkString)
+(gtk-import-function nil gtk_progress_set_adjustment GtkProgress GtkAdjustment)
+(gtk-import-function nil gtk_progress_configure GtkProgress gfloat gfloat gfloat)
+(gtk-import-function nil gtk_progress_set_percentage GtkProgress gfloat)
+(gtk-import-function nil gtk_progress_set_value GtkProgress gfloat)
+(gtk-import-function gfloat gtk_progress_get_value GtkProgress)
+(gtk-import-function nil gtk_progress_set_activity_mode GtkProgress guint)
+(gtk-import-function GtkString gtk_progress_get_current_text GtkProgress)
+(gtk-import-function GtkString gtk_progress_get_text_from_value GtkProgress gfloat)
+(gtk-import-function gfloat gtk_progress_get_current_percentage GtkProgress)
+(gtk-import-function gfloat gtk_progress_get_percentage_from_value GtkProgress gfloat)
+
+\f
+(gtk-import-function GtkType gtk_progress_bar_get_type)
+(gtk-import-function GtkWidget gtk_progress_bar_new)
+(gtk-import-function GtkWidget gtk_progress_bar_new_with_adjustment GtkAdjustment)
+(gtk-import-function nil gtk_progress_bar_set_bar_style GtkProgressBar GtkProgressBarStyle)
+(gtk-import-function nil gtk_progress_bar_set_discrete_blocks GtkProgressBar guint)
+(gtk-import-function nil gtk_progress_bar_set_activity_step GtkProgressBar guint)
+(gtk-import-function nil gtk_progress_bar_set_activity_blocks GtkProgressBar guint)
+(gtk-import-function nil gtk_progress_bar_set_orientation GtkProgressBar GtkProgressBarOrientation)
+(gtk-import-function nil gtk_progress_bar_update GtkProgressBar gfloat)
+
+\f
+;; All of the gpointers below really need to be `GSList *'
+;; For now, need to create the first radio button with 'nil' and then use
+;; (gtk-radio-button-group first-radio) for the rest.
+(gtk-import-function GtkType gtk_radio_button_get_type)
+(gtk-import-function GtkWidget gtk_radio_button_new gpointer)
+(gtk-import-function GtkWidget gtk_radio_button_new_from_widget GtkRadioButton)
+(gtk-import-function GtkWidget gtk_radio_button_new_with_label gpointer GtkString)
+(gtk-import-function GtkWidget gtk_radio_button_new_with_label_from_widget GtkRadioButton GtkString)
+(gtk-import-function gpointer gtk_radio_button_group GtkRadioButton)
+(gtk-import-function nil gtk_radio_button_set_group GtkRadioButton gpointer)
+
+\f
+(gtk-import-function GtkType gtk_radio_menu_item_get_type)
+
+;; #### BILLL!!
+;; All of these gpointer args should be GList *
+(gtk-import-function GtkWidget gtk_radio_menu_item_new gpointer)
+(gtk-import-function GtkWidget gtk_radio_menu_item_new_with_label gpointer GtkString)
+(gtk-import-function gpointer gtk_radio_menu_item_group GtkRadioMenuItem)
+(gtk-import-function nil gtk_radio_menu_item_set_group GtkRadioMenuItem gpointer)
+
+\f
+(gtk-import-function GtkType gtk_range_get_type)
+(gtk-import-function GtkAdjustment gtk_range_get_adjustment GtkRange)
+(gtk-import-function nil gtk_range_set_update_policy GtkRange GtkUpdateType)
+(gtk-import-function nil gtk_range_set_adjustment GtkRange GtkAdjustment)
+
+(gtk-import-function nil gtk_range_draw_background GtkRange)
+(gtk-import-function nil gtk_range_clear_background GtkRange)
+(gtk-import-function nil gtk_range_draw_trough GtkRange)
+(gtk-import-function nil gtk_range_draw_slider GtkRange)
+(gtk-import-function nil gtk_range_draw_step_forw GtkRange)
+(gtk-import-function nil gtk_range_draw_step_back GtkRange)
+(gtk-import-function nil gtk_range_slider_update GtkRange)
+
+;;; #### BILL!!! I think all of these are just for subclassing
+;;; widgets, which we will not be able to do.  Maybe much later.
+;;;gint           gtk_range_trough_click           (GtkRange      *range,
+;;;                                             gint           x,
+;;;                                             gint           y,
+;;;                                             gfloat        *jump_perc);
+
+(gtk-import-function nil gtk_range_default_hslider_update GtkRange)
+(gtk-import-function nil gtk_range_default_vslider_update GtkRange)
+
+;;;gint           gtk_range_default_htrough_click  (GtkRange      *range,
+;;;                                             gint           x,
+;;;                                             gint           y,
+;;;                                             gfloat        *jump_perc);
+;;;gint           gtk_range_default_vtrough_click  (GtkRange      *range,
+;;;                                             gint           x,
+;;;                                             gint           y,
+;;;                                             gfloat        *jump_perc);
+
+(gtk-import-function nil gtk_range_default_hmotion GtkRange gint gint)
+(gtk-import-function nil gtk_range_default_vmotion GtkRange gint gint)
+
+\f
+(gtk-import-function GtkType gtk_ruler_get_type)
+(gtk-import-function nil gtk_ruler_set_metric GtkRuler GtkMetricType)
+(gtk-import-function nil gtk_ruler_set_range GtkRuler gfloat gfloat gfloat gfloat)
+(gtk-import-function nil gtk_ruler_draw_ticks GtkRuler)
+(gtk-import-function nil gtk_ruler_draw_pos GtkRuler)
+
+\f
+(gtk-import-function GtkType gtk_scale_get_type)
+(gtk-import-function nil gtk_scale_set_digits GtkScale gint)
+(gtk-import-function nil gtk_scale_set_draw_value GtkScale gboolean)
+(gtk-import-function nil gtk_scale_set_value_pos GtkScale GtkPositionType)
+(gtk-import-function gint gtk_scale_get_value_width GtkScale)
+(gtk-import-function nil gtk_scale_draw_value GtkScale)
+
+\f
+(gtk-import-function GtkType gtk_scrollbar_get_type)
+
+\f
+(gtk-import-function GtkType gtk_scrolled_window_get_type)
+(gtk-import-function GtkWidget gtk_scrolled_window_new GtkAdjustment GtkAdjustment)
+(gtk-import-function nil gtk_scrolled_window_set_hadjustment GtkScrolledWindow GtkAdjustment)
+(gtk-import-function nil gtk_scrolled_window_set_vadjustment GtkScrolledWindow GtkAdjustment)
+(gtk-import-function GtkAdjustment gtk_scrolled_window_get_hadjustment GtkScrolledWindow)
+(gtk-import-function GtkAdjustment gtk_scrolled_window_get_vadjustment GtkScrolledWindow)
+(gtk-import-function nil gtk_scrolled_window_set_policy GtkScrolledWindow GtkPolicyType GtkPolicyType)
+(gtk-import-function nil gtk_scrolled_window_set_placement GtkScrolledWindow GtkCornerType)
+(gtk-import-function nil gtk_scrolled_window_add_with_viewport GtkScrolledWindow GtkWidget)
+
+\f
+(gtk-import-function GtkType gtk_separator_get_type)
+
+\f
+(gtk-import-function GtkType gtk_socket_get_type)
+(gtk-import-function GtkWidget gtk_socket_new)
+(gtk-import-function nil gtk_socket_steal GtkSocket guint)
+
+\f
+(gtk-import-function GtkType gtk_table_get_type)
+(gtk-import-function GtkWidget gtk_table_new guint guint gboolean)
+(gtk-import-function nil gtk_table_resize GtkTable guint guint)
+
+(gtk-import-function nil gtk_table_attach GtkTable GtkWidget
+                    guint guint guint guint GtkAttachOptions GtkAttachOptions guint
+                    guint)
+
+(gtk-import-function nil gtk_table_attach_defaults GtkTable GtkWidget guint guint guint guint)
+(gtk-import-function nil gtk_table_set_row_spacing GtkTable guint guint)
+(gtk-import-function nil gtk_table_set_col_spacing GtkTable guint guint)
+(gtk-import-function nil gtk_table_set_row_spacings GtkTable guint)
+(gtk-import-function nil gtk_table_set_col_spacings GtkTable guint)
+(gtk-import-function nil gtk_table_set_homogeneous GtkTable gboolean)
+
+\f
+(gtk-import-function GtkType gtk_tearoff_menu_item_get_type)
+(gtk-import-function GtkWidget gtk_tearoff_menu_item_new)
+
+\f
+(gtk-import-function GtkType gtk_text_get_type)
+(gtk-import-function GtkWidget gtk_text_new GtkAdjustment GtkAdjustment)
+(gtk-import-function nil gtk_text_set_editable GtkText gboolean)
+(gtk-import-function nil gtk_text_set_word_wrap GtkText gint)
+(gtk-import-function nil gtk_text_set_line_wrap GtkText gint)
+(gtk-import-function nil gtk_text_set_adjustments GtkText GtkAdjustment GtkAdjustment)
+(gtk-import-function nil gtk_text_set_point GtkText guint)
+(gtk-import-function guint gtk_text_get_point GtkText)
+(gtk-import-function guint gtk_text_get_length GtkText)
+(gtk-import-function nil gtk_text_freeze GtkText)
+(gtk-import-function nil gtk_text_thaw GtkText)
+(gtk-import-function nil gtk_text_insert GtkText GdkFont GdkColor GdkColor GtkString gint)
+(gtk-import-function nil gtk_text_backward_delete GtkText guint)
+(gtk-import-function nil gtk_text_forward_delete GtkText guint)
+
+\f
+(gtk-import-function GtkType gtk_tips_query_get_type)
+(gtk-import-function GtkWidget gtk_tips_query_new)
+(gtk-import-function nil gtk_tips_query_start_query GtkTipsQuery)
+(gtk-import-function nil gtk_tips_query_stop_query GtkTipsQuery)
+(gtk-import-function nil gtk_tips_query_set_caller GtkTipsQuery GtkWidget)
+(gtk-import-function nil gtk_tips_query_set_labels GtkTipsQuery GtkString GtkString)
+
+\f
+(gtk-import-function GtkType gtk_toggle_button_get_type)
+(gtk-import-function GtkWidget gtk_toggle_button_new)
+(gtk-import-function GtkWidget gtk_toggle_button_new_with_label GtkString)
+(gtk-import-function nil gtk_toggle_button_set_mode GtkToggleButton gboolean)
+(gtk-import-function nil gtk_toggle_button_set_active GtkToggleButton gboolean)
+(gtk-import-function gboolean gtk_toggle_button_get_active GtkToggleButton)
+(gtk-import-function nil gtk_toggle_button_toggled GtkToggleButton)
+
+\f
+(gtk-import-function GtkType gtk_toolbar_get_type)
+(gtk-import-function GtkWidget gtk_toolbar_new GtkOrientation GtkToolbarStyle)
+
+;; Simple button items
+;;; Handcoded in ui-byhand.c... #### FIXME
+;;;GtkWidget* gtk_toolbar_append_item     (GtkToolbar      *toolbar,
+;;;                                    const char      *text,
+;;;                                    const char      *tooltip_text,
+;;;                                    const char      *tooltip_private_text,
+;;;                                    GtkWidget       *icon,
+;;;                                    GtkSignalFunc    callback,
+;;;                                    gpointer         user_data);
+;;;GtkWidget* gtk_toolbar_prepend_item    (GtkToolbar      *toolbar,
+;;;                                    const char      *text,
+;;;                                    const char      *tooltip_text,
+;;;                                    const char      *tooltip_private_text,
+;;;                                    GtkWidget       *icon,
+;;;                                    GtkSignalFunc    callback,
+;;;                                    gpointer         user_data);
+;;;GtkWidget* gtk_toolbar_insert_item     (GtkToolbar      *toolbar,
+;;;                                    const char      *text,
+;;;                                    const char      *tooltip_text,
+;;;                                    const char      *tooltip_private_text,
+;;;                                    GtkWidget       *icon,
+;;;                                    GtkSignalFunc    callback,
+;;;                                    gpointer         user_data,
+;;;                                    gint             position);
+
+;; Space Items
+(gtk-import-function nil gtk_toolbar_append_space GtkToolbar)
+(gtk-import-function nil gtk_toolbar_prepend_space GtkToolbar)
+(gtk-import-function nil gtk_toolbar_insert_space GtkToolbar gint)
+
+;; Any element type
+;; Cannot currently do this!  Need to have something similar to
+;; GtkCallback in order to deal with this.
+;; Of what possible use are these functions?  I don't see the
+;; difference between them and the _item functions.
+;;
+;; From looking at the code in gtktoolbar.c, the GtkWidget argument
+;; here is ignored!!!
+'(gtk-import-function GtkWidget gtk_toolbar_append_element GtkToolbar
+                     GtkToolbarChildType
+                     GtkWidget
+                     GtkString
+                     GtkString
+                     GtkString
+                     GtkWidget
+                     GtkSignal
+                     gpointer)
+
+'(gtk-import-function GtkWidget gtk_toolbar_prepend_element GtkToolbar
+                     GtkToolbarChildType
+                     GtkWidget
+                     GtkString
+                     GtkString
+                     GtkString
+                     GtkWidget
+                     GtkSignal
+                     gpointer)
+
+'(gtk-import-function GtkWidget gtk_toolbar_insert_element GtkToolbar
+                     GtkToolbarChildType
+                     GtkWidget
+                     GtkString
+                     GtkString
+                     GtkString
+                     GtkWidget
+                     GtkSignal
+                     gpointer
+                     gint)
+
+;; Generic Widgets
+(gtk-import-function nil gtk_toolbar_append_widget GtkToolbar GtkWidget GtkString GtkString)
+(gtk-import-function nil gtk_toolbar_prepend_widget GtkToolbar GtkWidget GtkString GtkString)
+(gtk-import-function nil gtk_toolbar_insert_widget GtkToolbar GtkWidget GtkString GtkString gint)
+
+;; Style functions
+(gtk-import-function nil gtk_toolbar_set_orientation GtkToolbar GtkOrientation)
+(gtk-import-function nil gtk_toolbar_set_style GtkToolbar GtkToolbarStyle)
+(gtk-import-function nil gtk_toolbar_set_space_size GtkToolbar gint)
+(gtk-import-function nil gtk_toolbar_set_space_style GtkToolbar GtkToolbarSpaceStyle)
+(gtk-import-function nil gtk_toolbar_set_tooltips GtkToolbar gint)
+(gtk-import-function nil gtk_toolbar_set_button_relief GtkToolbar GtkReliefStyle)
+(gtk-import-function GtkReliefStyle gtk_toolbar_get_button_relief GtkToolbar)
+
+\f
+(gtk-import-function GtkType gtk_tooltips_get_type)
+(gtk-import-function GtkObject gtk_tooltips_new)
+(gtk-import-function nil gtk_tooltips_enable GtkTooltips)
+(gtk-import-function nil gtk_tooltips_disable GtkTooltips)
+(gtk-import-function nil gtk_tooltips_set_delay GtkTooltips guint)
+(gtk-import-function nil gtk_tooltips_set_tip GtkTooltips GtkWidget GtkString GtkString)
+(gtk-import-function nil gtk_tooltips_set_colors GtkTooltips GdkColor GdkColor)
+
+;;;GtkTooltipsData* gtk_tooltips_data_get         (GtkWidget     *widget);
+
+(gtk-import-function nil gtk_tooltips_force_window GtkTooltips)
+
+\f
+(gtk-import-function GtkType gtk_tree_get_type)
+(gtk-import-function GtkWidget gtk_tree_new)
+
+(gtk-import-function nil gtk_tree_append
+                    (GtkTree    . tree)
+                    (GtkWidget  . tree_item))
+(gtk-import-function nil gtk_tree_prepend
+                    (GtkTree    . tree)
+                    (GtkWidget  . tree_item))
+
+(gtk-import-function nil gtk_tree_insert
+                    (GtkTree    . tree)
+                    (GtkWidget  . tree_item)
+                    (gint       . position))
+
+(gtk-import-function nil gtk_tree_remove_items
+                    (GtkTree         . tree)
+                    (GtkListOfObject . items))
+
+(gtk-import-function nil gtk_tree_clear_items
+                    (GtkTree . tree)
+                    (gint    . start)
+                    (gint    . end))
+
+(gtk-import-function nil gtk_tree_select_item
+                    (GtkTree . tree)
+                    (gint    . item))
+
+(gtk-import-function nil gtk_tree_unselect_item
+                    (GtkTree . tree)
+                    (gint    . item))
+
+(gtk-import-function nil gtk_tree_select_child
+                    (GtkTree    . tree)
+                    (GtkWidget  . tree_item))
+
+(gtk-import-function nil gtk_tree_unselect_child
+                    (GtkTree    . tree)
+                    (GtkWidget  . tree_item))
+
+(gtk-import-function gint gtk_tree_child_position
+                    (GtkTree    . tree)
+                    (GtkWidget  . child))
+
+(gtk-import-function nil gtk_tree_set_selection_mode
+                    (GtkTree          . tree)
+                    (GtkSelectionMode . mode))
+
+(gtk-import-function nil gtk_tree_set_view_mode
+                    (GtkTree         . tree)
+                    (GtkTreeViewMode . mode))
+
+(gtk-import-function nil gtk_tree_set_view_lines
+                    (GtkTree  . tree)
+                    (gboolean . flag))
+
+;; deprecated function, use gtk_container_remove instead.
+(gtk-import-function nil gtk_tree_remove_item
+                    (GtkTree   . tree)
+                    (GtkWidget . child))
+
+\f
+(gtk-import-function GtkType gtk_tree_item_get_type)
+(gtk-import-function GtkWidget gtk_tree_item_new)
+(gtk-import-function GtkWidget gtk_tree_item_new_with_label GtkString)
+(gtk-import-function nil gtk_tree_item_set_subtree GtkTreeItem GtkWidget)
+(gtk-import-function nil gtk_tree_item_remove_subtree GtkTreeItem)
+(gtk-import-function nil gtk_tree_item_select GtkTreeItem)
+(gtk-import-function nil gtk_tree_item_deselect GtkTreeItem)
+(gtk-import-function nil gtk_tree_item_expand GtkTreeItem)
+(gtk-import-function nil gtk_tree_item_collapse GtkTreeItem)
+
+\f
+(gtk-import-function GtkString gtk_type_name GtkType)
+(gtk-import-function guint gtk_type_from_name GtkString)
+
+\f
+(gtk-import-function GtkType gtk_vbox_get_type)
+(gtk-import-function GtkWidget gtk_vbox_new gboolean gint)
+
+\f
+(gtk-import-function GtkType gtk_vbutton_box_get_type)
+(gtk-import-function GtkWidget gtk_vbutton_box_new)
+
+;; buttons can be added by gtk_container_add()
+(gtk-import-function gint gtk_vbutton_box_get_spacing_default)
+(gtk-import-function nil gtk_vbutton_box_set_spacing_default gint)
+
+(gtk-import-function GtkButtonBoxStyle gtk_vbutton_box_get_layout_default)
+(gtk-import-function nil gtk_vbutton_box_set_layout_default GtkButtonBoxStyle)
+
+\f
+(gtk-import-function GtkType gtk_viewport_get_type)
+(gtk-import-function GtkWidget gtk_viewport_new GtkAdjustment GtkAdjustment)
+(gtk-import-function GtkAdjustment gtk_viewport_get_hadjustment GtkViewport)
+(gtk-import-function GtkAdjustment gtk_viewport_get_vadjustment GtkViewport)
+(gtk-import-function nil gtk_viewport_set_hadjustment GtkViewport GtkAdjustment)
+(gtk-import-function nil gtk_viewport_set_vadjustment GtkViewport GtkAdjustment)
+(gtk-import-function nil gtk_viewport_set_shadow_type GtkViewport GtkShadowType)
+
+\f
+(gtk-import-function GtkType gtk_vpaned_get_type)
+(gtk-import-function GtkWidget gtk_vpaned_new)
+
+\f
+(gtk-import-function GtkType gtk_vruler_get_type)
+(gtk-import-function GtkWidget gtk_vruler_new)
+
+\f
+(gtk-import-function GtkType gtk_vscale_get_type)
+(gtk-import-function GtkWidget gtk_vscale_new GtkAdjustment)
+
+\f
+(gtk-import-function GtkType gtk_vscrollbar_get_type)
+(gtk-import-function GtkWidget gtk_vscrollbar_new GtkAdjustment)
+
+\f
+(gtk-import-function GtkType gtk_vseparator_get_type)
+(gtk-import-function GtkWidget gtk_vseparator_new)
+
+\f
+(gtk-import-function GtkType gtk_widget_get_type)
+(gtk-import-function nil gtk_widget_ref GtkWidget)
+(gtk-import-function nil gtk_widget_unref GtkWidget)
+(gtk-import-function nil gtk_widget_destroy GtkWidget)
+(gtk-import-function nil gtk_widget_unparent GtkWidget)
+(gtk-import-function nil gtk_widget_show GtkWidget)
+(gtk-import-function nil gtk_widget_show_now GtkWidget)
+(gtk-import-function nil gtk_widget_hide GtkWidget)
+(gtk-import-function nil gtk_widget_show_all GtkWidget)
+(gtk-import-function nil gtk_widget_hide_all GtkWidget)
+(gtk-import-function nil gtk_widget_map GtkWidget)
+(gtk-import-function nil gtk_widget_unmap GtkWidget)
+(gtk-import-function nil gtk_widget_realize GtkWidget)
+(gtk-import-function nil gtk_widget_unrealize GtkWidget)
+
+(gtk-import-function nil gtk_widget_queue_draw GtkWidget)
+(gtk-import-function nil gtk_widget_queue_draw_area GtkWidget gint gint gint gint)
+(gtk-import-function nil gtk_widget_queue_clear GtkWidget)
+(gtk-import-function nil gtk_widget_queue_clear_area GtkWidget gint gint gint gint)
+(gtk-import-function nil gtk_widget_queue_resize GtkWidget)
+
+;;; #### BILL!!!
+;(gtk-import-function nil gtk_widget_draw 'GtkWidget 'GdkRectangle)
+;(gtk-import-function nil gtk_widget_size_request 'GtkWidget 'GtkRequisition)
+;(gtk-import-function nil gtk_widget_size_allocate 'GtkWidget 'GtkAllocation)
+;(gtk-import-function nil gtk_widget_get_child_requisition 'GtkWidget 'GtkRequisition)
+;(gtk-import-function 'gint gtk_widget_intersect 'GtkWidget 'GdkRectangle 'GdkRectangle)
+
+(gtk-import-function nil gtk_widget_draw_focus GtkWidget)
+(gtk-import-function nil gtk_widget_draw_default GtkWidget)
+(gtk-import-function nil gtk_widget_add_accelerator GtkWidget GtkString GtkAccelGroup
+                    guint guint GtkAccelFlags)
+(gtk-import-function nil gtk_widget_remove_accelerator GtkWidget GtkAccelGroup guint guint)
+(gtk-import-function nil gtk_widget_remove_accelerators GtkWidget GtkString gboolean)
+(gtk-import-function guint gtk_widget_accelerator_signal GtkWidget GtkAccelGroup guint guint)
+(gtk-import-function nil gtk_widget_lock_accelerators GtkWidget)
+(gtk-import-function nil gtk_widget_unlock_accelerators GtkWidget)
+(gtk-import-function gboolean gtk_widget_accelerators_locked GtkWidget)
+(gtk-import-function gint gtk_widget_event GtkWidget GdkEvent)
+(gtk-import-function gboolean gtk_widget_activate GtkWidget)
+(gtk-import-function gboolean gtk_widget_set_scroll_adjustments GtkWidget GtkAdjustment GtkAdjustment)
+(gtk-import-function nil gtk_widget_reparent GtkWidget GtkWidget)
+(gtk-import-function nil gtk_widget_popup GtkWidget gint gint)
+(gtk-import-function nil gtk_widget_grab_focus GtkWidget)
+(gtk-import-function nil gtk_widget_grab_default GtkWidget)
+(gtk-import-function nil gtk_widget_set_name GtkWidget GtkString)
+(gtk-import-function GtkString gtk_widget_get_name GtkWidget)
+(gtk-import-function nil gtk_widget_set_state GtkWidget GtkStateType)
+(gtk-import-function nil gtk_widget_set_sensitive GtkWidget gboolean)
+(gtk-import-function nil gtk_widget_set_app_paintable GtkWidget gboolean)
+(gtk-import-function nil gtk_widget_set_parent GtkWidget GtkWidget)
+(gtk-import-function nil gtk_widget_set_parent_window GtkWindow GdkWindow)
+(gtk-import-function GdkWindow gtk_widget_get_parent_window GtkWidget)
+(gtk-import-function nil gtk_widget_set_uposition GtkWidget gint gint)
+(gtk-import-function nil gtk_widget_set_usize GtkWidget gint gint)
+(gtk-import-function nil gtk_widget_set_events GtkWidget GdkEventMask)
+(gtk-import-function nil gtk_widget_add_events GtkWidget GdkEventMask)
+(gtk-import-function nil gtk_widget_set_extension_events GtkWidget GdkExtensionMode)
+(gtk-import-function GdkExtensionMode gtk_widget_get_extension_events GtkWidget)
+(gtk-import-function GtkWidget gtk_widget_get_toplevel GtkWidget)
+(gtk-import-function GtkWidget gtk_widget_get_ancestor GtkWidget guint)
+(gtk-import-function GdkColormap gtk_widget_get_colormap GtkWidget)
+(gtk-import-function GdkVisual gtk_widget_get_visual GtkWidget)
+
+(gtk-import-function nil gtk_widget_set_colormap GtkWidget GdkColormap)
+(gtk-import-function nil gtk_widget_set_visual GtkWidget GdkVisual)
+(gtk-import-function GdkEventMask gtk_widget_get_events GtkWidget)
+
+;;; Hrm - this should return a cons cell.
+;;; Handcoded in ui-byhand.c... #### FIXME
+;;void      gtk_widget_get_pointer     (GtkWidget      *widget,
+;;                                      gint           *x,
+;;                                      gint           *y);
+
+(gtk-import-function gboolean gtk_widget_is_ancestor GtkWidget GtkWidget)
+(gtk-import-function gboolean gtk_widget_hide_on_delete GtkWidget)
+
+;;; Widget styles
+(gtk-import-function nil gtk_widget_set_style GtkWidget GtkStyle)
+(gtk-import-function nil gtk_widget_set_rc_style GtkWidget)
+(gtk-import-function nil gtk_widget_ensure_style GtkWidget)
+(gtk-import-function GtkStyle gtk_widget_get_style GtkWidget)
+(gtk-import-function nil gtk_widget_restore_default_style GtkWidget)
+(gtk-import-function nil gtk_widget_modify_style GtkWidget GtkStyle)
+
+(gtk-import-function nil gtk_widget_set_composite_name GtkWidget GtkString)
+(gtk-import-function GtkString gtk_widget_get_composite_name GtkWidget)
+(gtk-import-function nil gtk_widget_reset_rc_styles GtkWidget)
+
+;; Push/pop pairs, to change default values upon a widget's creation.
+;; This will override the values that got set by the
+;; gtk_widget_set_default_* () functions.
+(gtk-import-function nil gtk_widget_push_style GtkStyle)
+(gtk-import-function nil gtk_widget_push_colormap GdkColormap)
+(gtk-import-function nil gtk_widget_push_visual GdkVisual)
+(gtk-import-function nil gtk_widget_push_composite_child)
+(gtk-import-function nil gtk_widget_pop_composite_child)
+(gtk-import-function nil gtk_widget_pop_style)
+(gtk-import-function nil gtk_widget_pop_colormap)
+(gtk-import-function nil gtk_widget_pop_visual)
+
+;; Set certain default values to be used at widget creation time.
+(gtk-import-function nil gtk_widget_set_default_style GtkStyle)
+(gtk-import-function nil gtk_widget_set_default_colormap GdkColormap)
+(gtk-import-function nil gtk_widget_set_default_visual GdkVisual)
+(gtk-import-function GtkStyle gtk_widget_get_default_style)
+(gtk-import-function GdkColormap gtk_widget_get_default_colormap)
+(gtk-import-function GdkVisual gtk_widget_get_default_visual)
+
+;; Counterpart to gdk_window_shape_combine_mask.
+(gtk-import-function nil gtk_widget_shape_combine_mask GtkWidget GdkBitmap gint gint)
+
+;; internal function
+(gtk-import-function nil gtk_widget_reset_shapes GtkWidget)
+
+;; Compute a widget's path in the form "GtkWindow.MyLabel", and
+;; return newly alocated strings.
+;; Ignored for now #### BILL!!!
+;void       gtk_widget_path               (GtkWidget *widget,
+;                                          guint     *path_length,
+;                                          gchar    **path,
+;                                          gchar    **path_reversed);
+;void       gtk_widget_class_path         (GtkWidget *widget,
+;                                          guint     *path_length,
+;                                          gchar    **path,
+;                                          gchar    **path_reversed);
+
+\f
+(gtk-import-function GtkType gtk_window_get_type)
+(gtk-import-function GtkWidget gtk_window_new GtkWindowType)
+(gtk-import-function nil gtk_window_set_title GtkWindow GtkString)
+(gtk-import-function nil gtk_window_set_wmclass GtkWindow GtkString GtkString)
+(gtk-import-function nil gtk_window_set_policy GtkWindow gint gint gint)
+(gtk-import-function nil gtk_window_add_accel_group GtkWindow GtkAccelGroup)
+(gtk-import-function nil gtk_window_remove_accel_group GtkWindow GtkAccelGroup)
+(gtk-import-function nil gtk_window_set_position GtkWindow GtkWindowPosition)
+(gtk-import-function gint gtk_window_activate_focus GtkWindow)
+(gtk-import-function gint gtk_window_activate_default GtkWindow)
+(gtk-import-function nil gtk_window_set_transient_for GtkWindow GtkWindow)
+;(gtk-import-function nil gtk_window_set_geometry_hints GtkWindow GtkWidget GdkGeometry GdkWindowHints)
+(gtk-import-function nil gtk_window_set_default_size GtkWindow gint gint)
+(gtk-import-function nil gtk_window_set_modal GtkWindow gboolean)
+
+;; Internal functions - do we really want to expose these?
+;; NO
+'(gtk-import-function nil gtk_window_set_focus GtkWindow GtkWidget)
+'(gtk-import-function nil gtk_window_set_default GtkWindow GtkWidget)
+'(gtk-import-function nil gtk_window_remove_embedded_xid GtkWindow guint)
+'(gtk-import-function nil gtk_window_add_embedded_xid GtkWindow guint)
+'(gtk-import-function nil gtk_window_reposition GtkWindow gint gint)
+
+\f
+(gtk-import-function GtkType gtk_spin_button_get_type)
+(gtk-import-function nil gtk_spin_button_configure
+                    (GtkSpinButton . spin_button)
+                    (GtkAdjustment . adjustment)
+                    (gfloat        . climb_rate)
+                    (guint         . digits))
+(gtk-import-function GtkWidget gtk_spin_button_new
+                    (GtkAdjustment . adjustment)
+                    (gfloat        . climb_rate)
+                    (guint         . digits))
+(gtk-import-function nil gtk_spin_button_set_adjustment
+                    (GtkSpinButton . spin_button)
+                    (GtkAdjustment . adjustment))
+(gtk-import-function GtkAdjustment gtk_spin_button_get_adjustment
+                    (GtkSpinButton . spin_button))
+(gtk-import-function nil gtk_spin_button_set_digits
+                    (GtkSpinButton . spin_button)
+                    (guint         . digits))
+(gtk-import-function gfloat gtk_spin_button_get_value_as_float
+                    (GtkSpinButton . spin_button))
+(gtk-import-function gint gtk_spin_button_get_value_as_int
+                    (GtkSpinButton . spin_button))
+(gtk-import-function nil gtk_spin_button_set_value
+                    (GtkSpinButton . spin_button)
+                    (gfloat        . value))
+(gtk-import-function nil gtk_spin_button_set_update_policy
+                    (GtkSpinButton . spin_button)
+                    (GtkSpinButtonUpdatePolicy . policy))
+(gtk-import-function nil gtk_spin_button_set_numeric
+                    (GtkSpinButton . spin_button)
+                    (gboolean      . numeric))
+(gtk-import-function nil gtk_spin_button_spin
+                    (GtkSpinButton . spin_button)
+                    (GtkSpinType   . direction)
+                    (gfloat        . increment))
+(gtk-import-function nil gtk_spin_button_set_wrap
+                    (GtkSpinButton . spin_button)
+                    (gboolean      . wrap))
+(gtk-import-function nil gtk_spin_button_set_shadow_type
+                    (GtkSpinButton . spin_button)
+                    (GtkShadowType . shadow_type))
+(gtk-import-function nil gtk_spin_button_set_snap_to_ticks
+                    (GtkSpinButton . spin_button)
+                    (gboolean      . snap_to_ticks))
+(gtk-import-function  nil gtk_spin_button_update
+                     (GtkSpinButton . spin_button))
+
+\f
+(gtk-import-function GtkType gtk_statusbar_get_type)
+(gtk-import-function GtkWidget gtk_statusbar_new)
+(gtk-import-function guint gtk_statusbar_get_context_id
+                    (GtkStatusbar . statusbar)
+                    (GtkString    . context_description))
+
+;; Returns message_id used for gtk_statusbar_remove
+(gtk-import-function guint gtk_statusbar_push
+                    (GtkStatusbar . statusbar)
+                    (guint        . context_id)
+                    (GtkString    . text))
+(gtk-import-function nil gtk_statusbar_pop
+                    (GtkStatusbar . statusbar)
+                    (guint        . context_id))
+(gtk-import-function nil gtk_statusbar_remove
+                    (GtkStatusbar . statusbar)
+                    (guint        . context_id)
+                    (guint        . message_id))
+
+\f
+(gtk-import-function GtkType gtk_ctree_get_type)
+(gtk-import-function none gtk_ctree_construct
+                    (GtkCTree . ctree)
+                    (gint     . columns)
+                    (gint     . tree_column)
+                    (GtkArrayOfString . titles))
+(gtk-import-function GtkWidget gtk_ctree_new_with_titles
+                    (gint . columns)
+                    (gint . tree_column)
+                    (GtkArrayOfString . titles))
+(gtk-import-function GtkWidget gtk_ctree_new
+                    (gint . columns)
+                    (gint . tree_column))
+
+(gtk-import-function GtkCTreeNode gtk_ctree_insert_node
+                    (GtkCTree . ctree)
+                    (GtkCTreeNode . parent)
+                    (GtkCTreeNode . sibling)
+                    (GtkArrayOfString . text)
+                    (guint . spacing)
+                    (GdkPixmap . pixmap_closed)
+                    (GdkBitmap . mask_closed)
+                    (GdkPixmap . pixmap_opened)
+                    (GdkBitmap . mask_opened)
+                    (gboolean . is_leaf)
+                    (gboolean . expanded))
+
+(gtk-import-function none gtk_ctree_remove_node
+                    (GtkCTree . ctree)
+                    (GtkCTreeNode . node))
+
+(gtk-import-function none gtk_ctree_expand
+                    (GtkCTree . ctree)
+                    (GtkCTreeNode . node))
+
+(gtk-import-function none gtk_ctree_move
+                    (GtkCTree  . ctree)
+                    (GtkCTreeNode . node)
+                    (GtkCTreeNode . new_parent)
+                    (GtkCTreeNode . new_sibling))
+
+(gtk-import-function void gtk_ctree_expand_recursive
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node))
+
+(gtk-import-function void gtk_ctree_expand_to_depth
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node)
+                    (gint         . depth))
+
+(gtk-import-function void gtk_ctree_collapse
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node))
+
+(gtk-import-function void gtk_ctree_collapse_recursive
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node))
+
+(gtk-import-function void gtk_ctree_collapse_to_depth
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node)
+                    (gint         . depth))
+
+(gtk-import-function void gtk_ctree_toggle_expansion
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node))
+
+(gtk-import-function void gtk_ctree_toggle_expansion_recursive
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node))
+
+(gtk-import-function void gtk_ctree_select
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node))
+
+(gtk-import-function void gtk_ctree_select_recursive
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node))
+
+(gtk-import-function void gtk_ctree_unselect
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node))
+
+(gtk-import-function void gtk_ctree_unselect_recursive
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node))
+
+;; NOTE!!! The header file here was WRONG!  It had a third arg 'gint state'
+(gtk-import-function void gtk_ctree_real_select_recursive
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node))
+
+;; Analogs of GtkCList functions
+(gtk-import-function void gtk_ctree_node_set_text
+                     (GtkCTree . ctree)
+                    (GtkCTreeNode . node)
+                    (gint . column)
+                    (GtkString . text))
+
+(gtk-import-function void gtk_ctree_node_set_pixmap
+                    (GtkCTree . ctree)
+                    (GtkCTreeNode . node)
+                    (gint . column)
+                    (GdkPixmap . pixmap)
+                    (GdkBitmap . mask))
+
+(gtk-import-function void gtk_ctree_node_set_pixtext
+                    (GtkCTree . ctree)
+                    (GtkCTreeNode . node)
+                    (gint . column)
+                    (GtkString . text)
+                    (guint . spacing)
+                    (GdkPixmap . pixmap)
+                    (GdkBitmap . mask))
+
+(gtk-import-function void gtk_ctree_set_node_info
+                     (GtkCTree . ctree)
+                    (GtkCTreeNode . node)
+                    (GtkString . text)
+                    (guint . spacing)
+                    (GdkPixmap . pixmap_closed)
+                    (GdkBitmap . mask_closed)
+                    (GdkPixmap . pixmap_opened)
+                    (GdkBitmap . mask_opened)
+                    (gboolean  . is_leaf)
+                    (gboolean  . expanded))
+
+(gtk-import-function void gtk_ctree_node_set_shift
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node)
+                    (gint         . column)
+                    (gint         . vertical)
+                    (gint         . horizontal))
+
+(gtk-import-function void gtk_ctree_node_set_selectable
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node)
+                    (gboolean     . selectable))
+
+(gtk-import-function gboolean gtk_ctree_node_get_selectable
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node))
+
+(gtk-import-function GtkCellType gtk_ctree_node_get_cell_type
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node)
+                    (gint         . column))
+
+(gtk-import-function void gtk_ctree_node_set_row_style
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node)
+                    (GtkStyle     . style))
+
+(gtk-import-function GtkStyle gtk_ctree_node_get_row_style
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node))
+
+(gtk-import-function void gtk_ctree_node_set_cell_style
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node)
+                    (gint         . column)
+                    (GtkStyle     . style))
+
+(gtk-import-function GtkStyle gtk_ctree_node_get_cell_style
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node)
+                    (gint         . column))
+
+(gtk-import-function void gtk_ctree_node_set_foreground
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node)
+                    (GdkColor     . color))
+
+(gtk-import-function void gtk_ctree_node_set_background
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node)
+                    (GdkColor     . color))
+
+(gtk-import-function void gtk_ctree_node_moveto
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node)
+                    (gint         . column)
+                    (gfloat       . row_align)
+                    (gfloat       . col_align))
+
+(gtk-import-function GtkVisibility gtk_ctree_node_is_visible
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node))
+
+;; GtkCTree specific functions
+(gtk-import-function void gtk_ctree_set_indent
+                    (GtkCTree                . ctree)
+                    (gint                    . indent))
+
+(gtk-import-function void gtk_ctree_set_spacing
+                    (GtkCTree                . ctree)
+                    (gint                    . spacing))
+
+(gtk-import-function void gtk_ctree_set_show_stub
+                    (GtkCTree                . ctree)
+                    (gboolean                . show_stub))
+
+(gtk-import-function void gtk_ctree_set_line_style
+                    (GtkCTree                . ctree)
+                    (GtkCTreeLineStyle       . line_style))
+
+(gtk-import-function void gtk_ctree_set_expander_style
+                    (GtkCTree                . ctree)
+                    (GtkCTreeExpanderStyle   . expander_style))
+
+;; Tree sorting functions
+(gtk-import-function void gtk_ctree_sort_node
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node))
+
+(gtk-import-function void gtk_ctree_sort_recursive
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node))
+
+;; Finding tree information
+(gtk-import-function gboolean gtk_ctree_is_viewable
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node))
+(gtk-import-function GtkCTreeNode gtk_ctree_last
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node))
+(gtk-import-function GtkCTreeNode gtk_ctree_find_node_ptr
+                    (GtkCTree     . ctree)
+                    (GtkCTreeRow  . ctree_row))
+(gtk-import-function GtkCTreeNode gtk_ctree_node_nth
+                    (GtkCTree     . ctree)
+                    (guint        . row))
+(gtk-import-function gboolean gtk_ctree_find
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node)
+                    (GtkCTreeNode . child))
+(gtk-import-function gboolean gtk_ctree_is_ancestor
+                    (GtkCTree     . ctree)
+                    (GtkCTreeNode . node)
+                    (GtkCTreeNode . child))
+(gtk-import-function gboolean gtk_ctree_is_hot_spot
+                    (GtkCTree     . ctree)
+                    (gint         . x)
+                    (gint         . y))
+
+(defun gtk-ctree-post-recursive (ctree node func data)
+  (gtk-ctree-recurse ctree node func data t nil))
+
+(defun gtk-ctree-post-recursive-to-depth (ctree node depth func data)
+  (gtk-ctree-recurse ctree node func data t depth))
+
+(defun gtk-ctree-pre-recursive (ctree node func data)
+  (gtk-ctree-recurse ctree node func data nil nil))
+
+(defun gtk-ctree-pre-recursive-to-depth (ctree node depth func data)
+  (gtk-ctree-recurse ctree node func data nil depth))
+
+\f
+(gtk-import-function GtkType gtk_preview_get_type)
+(gtk-import-function void gtk_preview_uninit)
+(gtk-import-function GtkWidget gtk_preview_new
+                    (GtkPreviewType . type))
+(gtk-import-function void gtk_preview_size
+                    (GtkPreview      . preview)
+                    (gint            . width)
+                    (gint            . height))
+(gtk-import-function void gtk_preview_put
+                    (GtkPreview      . preview)
+                    (GdkWindow       . window)
+                    (GdkGC           . gc)
+                    (gint            . srcx)
+                    (gint            . srcy)
+                    (gint            . destx)
+                    (gint            . desty)
+                    (gint            . width)
+                    (gint            . height))
+(gtk-import-function void gtk_preview_draw_row
+                    (GtkPreview      . preview)
+                    (GtkString       . data)
+                    (gint            . x)
+                    (gint            . y)
+                    (gint            . w))
+(gtk-import-function void gtk_preview_set_expand
+                    (GtkPreview      . preview)
+                    (gboolean        . expand))
+(gtk-import-function void gtk_preview_set_gamma
+                    (double          . gamma))
+(gtk-import-function void gtk_preview_set_color_cube
+                    (guint           . nred_shades)
+                    (guint           . ngreen_shades)
+                    (guint           . nblue_shades)
+                    (guint           . ngray_shades))
+(gtk-import-function void gtk_preview_set_install_cmap
+                    (gboolean        . install_cmap))
+(gtk-import-function void gtk_preview_set_reserved
+                    (gint            . nreserved))
+;;;(gtk-import-function void gtk_preview_set_dither
+;;;                 (GtkPreview      . preview)
+;;;                 (GdkRgbDither    . dither))
+
+(gtk-import-function GdkVisual gtk_preview_get_visual)
+(gtk-import-function GdkColormap gtk_preview_get_cmap)
+(gtk-import-function GtkPreviewInfo gtk_preview_get_info)
+
+;; This function reinitializes the preview colormap and visual from
+;; the current gamma/color_cube/install_cmap settings. It must only
+;; be called if there are no previews or users's of the preview
+;; colormap in existence.
+(gtk-import-function void gtk_preview_reset)

diff --git a/lisp/gtk.el b/lisp/gtk.el
new file mode 100644 (file)
index 0000000..f7cd3bf
--- /dev/null
+++ b/lisp/gtk.el
@@ -0,0 +1,19 @@
+(gtk-import-function nil "gdk_flush")
+
+(defun gtk-describe-enumerations ()
+  "Show a list of all GtkEnum or GtkFlags objects available from lisp."
+  (interactive)
+  (set-buffer (get-buffer-create "*GTK Enumerations*"))
+  (erase-buffer)
+  (let ((separator (make-string (- (window-width) 3) ?-)))
+    (maphash (lambda (key val)
+              (insert
+               separator "\n"
+               (if (stringp key)
+                   key
+                 (gtk-type-name key)) "\n")
+              (mapc (lambda (cell)
+                      (insert (format "\t%40s == %d\n" (car cell) (cdr cell)))) val))
+            gtk-enumeration-info))
+  (goto-char (point-min))
+  (display-buffer (current-buffer)))

diff --git a/lisp/widgets-gtk.el b/lisp/widgets-gtk.el
new file mode 100644 (file)
index 0000000..38a151a
--- /dev/null
+++ b/lisp/widgets-gtk.el
@@ -0,0 +1,135 @@
+;;; 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).
+
+(defvar foo)
+
+(defun gtk-widget-instantiate-button-internal (plist callback)
+  (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 (lambda (wid real-cb)
+                                            (if (functionp real-cb)
+                                                (funcall real-cb)
+                                              (eval real-cb)))
+                          callback))
+      (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
+                            (lambda (wid data)
+                              ;; data is (real-cb . sibling)
+                              )
+                            (cons callback 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
+                          (lambda (wid real-cb)
+                            (if (functionp real-cb)
+                                (funcall real-cb)
+                              (eval real-cb)))
+                          callback)))
+
+    (gtk-widget-show-all widget)
+    widget))
+
+(defun gtk-widget-instantiate-notebook-internal (plist callback)
+  (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 callback)
+  (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 callback)
+  (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 (or (plist-get plist :callback) 'ignore))))
+    (add-timeout 0.1 (lambda (obj)
+                      (gtk-widget-set-style obj
+                                            (gtk-widget-get-style
+                                             (frame-property nil 'text-widget))))
+                widget)
+    (setq x widget)
+    widget))
+
+(defun gtk-widget-property-internal ()
+  nil)
+
+(defun gtk-widget-redisplay-internal ()
+  nil)
+
+(provide 'widgets-gtk)

diff --git a/src/ChangeLog.GTK b/src/ChangeLog.GTK
new file mode 100644 (file)
index 0000000..c72b1ba
--- /dev/null
+++ b/src/ChangeLog.GTK
@@ -0,0 +1,868 @@
+2000-10-03  William M. Perry  <wmperry@aventail.com>
+
+       * objects-gtk.c (gtk_font_instance_truename): Make sure we get the
+       fully expanded version of the font.
+
+       * device-gtk.c (convert_font): Ditto.
+
+       * gtk-xemacs.c (convert_font): Tell __get_gtk_font_truename to not
+       expand wildcards.
+
+       * objects-gtk.c (__get_gtk_font_truename): Use the internal
+       name-list in a GdkFont structure to find the truename of the
+       font.  This protects us from crashing if we get a FontSet
+       instead of a Font.
+
+       (__get_gtk_font_truename): Accept new argument 'expandp' for
+       whether to return the FULL font name or the wildcarded version.
+
+2000-09-21  William M. Perry  <wmperry@aventail.com>
+
+       * device-gtk.c (Fgtk_init): Moved calls to gtk_init or gnome_init
+       to separate function, and expose it to lisp.  It is now possible
+       to create GTK applications from batch mode.
+       (gtk_init_device): Use the new function.
+
+2000-09-12  William M. Perry  <wmperry@aventail.com>
+
+       * gtk-glue.c (gdk_event_to_emacs_event): Special case double
+       and triple clicks when converting events to lisp objects.
+       This allows something like GtkCList to treat double-clicks
+       differently in the 'select_row' signal.
+
+2000-09-11  William M. Perry  <wmperry@aventail.com>
+
+       * menubar-gtk.c (menu_create_menubar): Set a special name for
+       GtkMenuItems directly in the menubar.
+
+2000-09-10  William M. Perry  <wmperry@aventail.com>
+
+       * gtk-xemacs.c (gtk_xemacs_size_request): Deal with frame
+       being NULL.
+
+       * gtk-xemacs.c (gtk_xemacs_size_allocate): Ditto.
+
+2000-09-09  William M. Perry  <wmperry@aventail.com>
+
+       * sound.c (init_native_sound): Enable sound for GTK devices.
+
+       * device-gtk.c (gtk_init_device): Attempt to load a default
+       gtkrc file from the data directory.  This way we can enable
+       the default face font handling in gtk-faces.el but not screw
+       the majority of users with a proportional font by default.
+
+       * device-gtk.c (gtk_init_device): Attempt to load
+       ~/.xemacs/gtk-options.el when GTK devices are created.  This
+       allows for setting a persistent geometry without requiring GNOME.
+
+       * gtk-xemacs.c (gtk_xemacs_style_set): Deal with NULL frame.
+
+       * device-gtk.c (gtk_init_device): Make app_shell a GtkXEmacs
+       widget so that style information is retrieved correctly.
+
+       * menubar-gtk.c (gtk_xemacs_menubar_get_type): New subclass of
+       GtkMenuBar that always requests the same width as the text
+       widget.  This fixes the spurious frame resizes when there were too
+       many menu items to display in the desired width.
+       (create_menubar_widget): Use the new subclass.
+
+2000-09-08  William M. Perry  <wmperry@aventail.com>
+
+       * device-gtk.c (Fgtk_keysym_on_keyboard_p): Ported function from
+       the X side of things.
+
+       * device-gtk.c (gtk_mark_device): Make sure that we mark the
+       keysym hashtable or things go boom.
+
+2000-09-07  William M. Perry  <wmperry@aventail.com>
+
+       * menubar-gtk.c (gtk_update_frame_menubars): Don't actually
+       update the menubars if the menu is up.  This fixes the weird
+       problem where if you had a menu up and 'message' was called
+       (this happens a lot with the 'customize' menu), the menu would
+       disappear.  This is because XEmacs is fairly lame about when
+       it updates the menus - the message logging code eventually
+       does a (save-excursion (set-buffer " *Message Log*") ...).
+       The set-buffer caused magic variable current-menubar to be
+       evaluated, which calls gtk_update_frame_menubars, which would
+       nuke the menus.  Gack.
+
+2000-09-06  William M. Perry  <wmperry@aventail.com>
+
+       * event-gtk.c (gtk_event_to_emacs_event): Reworked how we handle
+       removing the shift modifier of normal keys (a & A, etc) to be more
+       like MS-windows.  This makes everything work pretty happily with
+       query-replace and apropos now.
+
+2000-09-05  William M. Perry  <wmperry@aventail.com>
+
+       * select-gtk.c (emacs_gtk_selection_received): Signal a fake
+       event here so that the event loop will wake up.  Should fix
+       the strange pause seen when pasting.
+
+       * select-gtk.c (Fgtk_get_clipboard): Signal an error if no
+       selections are available.  This is more meaningful than 'insert'
+       throwing an error when it gets 'nil'.
+
+       * select-gtk.c (emacs_gtk_selection_received): Don't bother
+       checking whether the data returned as the selection is a string.
+       If it is not, we convert it to binary data anyway.  This fixes the
+       bug where you could not paste between two separate XEmacs
+       instances w/mule enabled (it sends selections as COMPOUND_TEXT).
+
+       * device-gtk.c (Fgtk_style_info): Return the default font name as
+       part of the style info.
+
+       * menubar-gtk.c (__generic_button_callback): make sure that we
+       provide a channel for our menu events.  This fixes things like
+       get-dialog-box-response that rely on event-channel !nilp
+
+2000-09-05  William M. Perry  <wmperry@aventail.com>
+
+       * glyphs-gtk.c (__downcase): Actually return the downcased string!
+        Thanks to Michael Altenhofen <Michael.Altenhofen@sap.com> for
+       spotting this.
+
+2000-09-05  William M. Perry  <wmperry@aventail.com>
+
+       * menubar-gtk.c (gtk_popup_menu): Make sure we call
+       __activate_menu correctly if the menu is dynamic.  This fixes
+       popup menus with :filter effects.
+
+2000-09-01  William M. Perry  <wmperry@aventail.com>
+
+       * gpmevent.c, gpmevent.h: Updated to the latest XEmacs 21.2
+       version of gpmevent.c.  This means that GPM support works
+       with GTK now.
+
+       * console-tty.c, console-tty.h: Removed old GPM support.
+
+       * device-tty.c, emacs.c, event-Xt.c: Ditto.
+
+       * event-unixoid.c, frame-tty.c: Ditto.
+
+2000-08-30  William M. Perry  <wmperry@aventail.com>
+
+       * gtk-xemacs.c (smash_scrollbar_specifiers): Don't bother looking
+       for nextstep themed scrollbars - didn't work anyway.
+
+       * glade.c (Fglade_xml_textdomain): deal with old versions of Glade
+       that use 'textdomain' instead of 'txtdomain' in the structure.
+
+       * menubar-gtk.c (gtk_popup_menu): use gtk_widget_show instead of
+       gtk_widget_show_all so that the magic `space-saver' menu item does
+       not get shown on popups.
+
+2000-08-27  William M. Perry  <wmperry@aventail.com>
+
+       * scrollbar-gtk.c (gtk_update_scrollbar_instance_status): Fiddle
+       with scrollbar_values -> GtkAdjustment conversion and scrolling up
+       with the arrows works correctly now.
+
+       * event-gtk.c (gtk_event_to_emacs_event): Fixed the shifted key
+       lossage (pc-select works now).
+
+2000-08-11  William M. Perry  <wmperry@aventail.com>
+
+       * scrollbar-gtk.c (scrollbar_cb): Need to make sure we look at the
+       appropriate scrollbar instances from the mirror.  Was looking only
+       at the vertical scrollbar instance.  Don't know if this has
+       anything to do with the weird scrolling behaviour, but it is worth
+       a shot.
+
+2000-07-26  William M. Perry  <wmperry@aventail.com>
+
+       * menubar-gtk.c (run_menubar_hook): New function that runs
+       activate-menubar-hook if the menu shell it was invoked by is
+       currently inactive.
+       (create_menubar_widget): Hook up the button-press-event to
+       run_menubar_hook to cater to broken packages.
+
+2000-07-22  William M. Perry  <wmperry@aventail.com>
+
+       * frame-gtk.c (gtk_popup_frame): When the window is supposed to be
+       initially unmapped, we need to make sure we realize the text
+       widget (to avoid lossage in redisplay assuming there is a valid
+       window), but NOT show it.
+
+2000-07-12  William M. Perry  <wmperry@aventail.com>
+
+       * menubar-gtk.c (__kill_stupid_gtk_timer): New function to kill
+       the timer on a GtkMenuItem widget.  This timer and its callback
+       appear to be what was causing heavily filtered menus (like
+       customize and other things under 'options') to crash.  The GTK
+       code installs a timer when the user is moving the mouse around to
+       scan menus.  Submenus are only popped up when this timer expires.
+       But if the filters are constantly running and creating/destroying
+       submenus, then you can blow up when they unconditionally check
+       GTK_WIDGET_FLAGS(menu_item->submenu), when submenu is NULL.
+
+2000-07-11  William M. Perry  <wmperry@aventail.com>
+
+       * device-gtk.c (gtk_init_device): Can now pass the entire argv
+       array that is in gtk-initial-argv-list, since gtk-init filters out
+       unknown options that may cause GTK to puke for us.  This means
+       that GNOME session management works now.
+
+       * frame-gtk.c (gnome_parse_geometry): Ripped this out of the GNOME
+       libraries to parse geometry settings, in case the user did not
+       compile with GNOME.
+       (gtk_initialize_frame_size): If gtk_initial_geometry is !NILP,
+       then try to parse it and use that.  If the geometry cannot be
+       parsed, fall back to using 80x30.
+
+       * device-gtk.c (Vgtk_initial_geometry): New variable exposed to
+       lisp holding the desired geometry of initial frames.
+
+2000-07-09  William M. Perry  <wmperry@aventail.com>
+
+       * ui-gtk.c (Fgtk_call_function): Outlined possible `enhancement'
+       if someone calls gtk-call-function with too few arguments.  After
+       I implemented it I realized it was probably a bad idea, so I
+       commented it out.  Maybe for the future...
+
+       * menubar-gtk.c (menu_convert): Can now pass in a GtkWidget to
+       reuse.  It detaches submenus, cleans up any GCPROs on it, and
+       attaches a new submenu.  All done in an effort to stop the menubar
+       flickering.
+       (menu_create_menubar): No longer willy-nilly deletes all of the
+       items in the top-level menubar.  We now check to see if the widget
+       already existing at the desired position has the same label as
+       this menu.  If it does, we pass it in to menu_convert.  This
+       drastically reduces the flickering menu problem that most people
+       have been seeing (try speedbar now).
+
+2000-07-04  William M. Perry  <wmperry@aventail.com>
+
+       * event-gtk.c (gtk_event_to_emacs_event): If FRAME is NULL, then
+       default to the selected frame on Vdefault_gtk_device.  This will
+       only happen when being called from gtk-glue.c
+
+       * ui-gtk.c (gtk_type_to_lisp): Properly convert GTK_TYPE_GDK_EVENT
+       objects to lisp events.
+
+       * event-gtk.c (gtk_event_to_emacs_event): Made this non-static so
+       that gtk-glue.c can use it.
+
+       * gtk-glue.c (gdk_event_to_emacs_event): New function to convert a
+       GDK event into something sensible for lisp.  Just uses
+       gtk_event_to_emacs_event() from event-gtk.c to avoid code
+       duplication.  Not perfect (the channel is set to the selected
+       frame, not the GtkObject it actually happened on).
+
+       * event-gtk.c (gtk_event_to_emacs_event): Finally fixed the weird
+       selection problem where if you released the mouse button over the
+       root window, XEmacs would get confused and still think the
+       selection was going on.
+
+       * ui-gtk.c (Fgtk_describe_type): New function to return the
+       signals and magic properties of an object given its name or type
+       identifier.
+
+2000-07-03  William M. Perry  <wmperry@aventail.com>
+
+       * ui-byhand.c (Fgtk_ctree_recurse): New function gtk-ctree-recurse
+       that encompasses gtk_ctree_post_recursive,
+       gtk_ctree_pre_recursive, gtk_ctree_post_recursive_to_depth, and
+       gtk_ctree_pre_recursive_to_depth.  All hail lisp bindings with
+       variable number of arguments.
+       (Fgtk_ctree_recurse): Allow nil for the node.
+
+       * ui-gtk.c (emacs_gtk_boxed_equality): New function for comparing
+       two GtkBoxed objects.  This is needed because there is no way to
+       store a `user_data' or equivalent on them, so we cannot resurrect
+       it like a GtkObject so we always get the same Lisp_Object.  This
+       allows callbacks to use `equal' on two GtkBoxed types and get sane
+       results.
+       (emacs_gtk_boxed_hash): New function for hashing GtkBoxed
+       objects.
+
+2000-07-01  William M. Perry  <wmperry@aventail.com>
+
+       * glade.c: New file to implement glue code for libglade. 
+
+2000-06-30  William M. Perry  <wmperry@aventail.com>
+
+       * ui-gtk.c (lisp_to_gtk_type): Know how to deal with
+       GTK_TYPE_GDK_GC.
+
+       * gtk-glue.c: Need to defien a GTK type for GdkGC so that we can
+       import all the GDK drawing primitives.
+       (face_to_gc): New function to convert a face object to a GC.
+
+2000-06-27  William M. Perry  <wmperry@aventail.com>
+
+       * ui-gtk.c (Fgtk_import_variable_internal): Renamed to -internal.
+
+2000-06-25  Vladimir Vukicevic <vladimir@helixcode.com>
+
+       * frame-gtk.c (gtk_set_initial_frame_size): Added in a call to
+       gtk_window_set_policy so that you can resize the window down below
+       the minimum size of the menubar.
+
+2000-06-23  William M. Perry  <wmperry@aventail.com>
+
+       * emacs.c (Fkill_emacs): Make sure we clean up the .saves* files
+       on normal exit.
+
+2000-06-13  William M. Perry  <wmperry@aventail.com>
+
+       * menubar-gtk.c (__activate_filtermenu): Put in some of the same
+       protections for filter menus that the normal menus have for widget
+       deletion and selected menu items, etc.
+
+2000-06-12  William M. Perry  <wmperry@aventail.com>
+
+       * scrollbar-gtk.c (gtk_create_scrollbar_instance): hide a
+       scrollbar widget until we are absolutely sure we need to see it.
+       Fixes the problem we were seeing with mouse-avoidance-mode causing
+       severe scrollbar breakage.
+       (update_one_widget_scrollbar_pointer): Move the call to
+       gtk_widget_realize() here instead of in the upper code.  Isolates
+       the dependency-on-having-a-window logic.
+
+       * gtk-xemacs.c (smash_scrollbar_specifiers): When setting the
+       scrollbar specifiers, need to take the x/y thickness of the border
+       into account.  Horizontal scrollbar placement is much much nicer
+       now.  Some themes would cause them to get positioned partially on
+       top of the modeline.
+
+2000-06-08  William M. Perry  <wmperry@aventail.com>
+
+       * console.c (select_console_1): Duh, forgot to put in an 'else'
+       statement, so Vwindow_system was getting set to Qnil all the
+       time.  *sigh*.
+
+2000-06-02  William M. Perry  <wmperry@aventail.com>
+
+       * glyphs-gtk.c (gtk_xpm_instantiate): Do not allow pixmaps to be
+       instantiated as pointers under GTK.  The pixmap and cursor
+       routines under GDK do not expose enough information to let use do
+       the same magic that glyphs-x.c does.  *sigh*
+
+       * ui-byhand.c (Fgtk_toolbar_insert_item): Hand-rolled function.
+       (Fgtk_toolbar_prepend_item): Ditto.
+       (generic_toolbar_insert_item): Utility function to take care of
+       all the common code for the Fgtk_toolbar_*_item functions.
+
+2000-06-01  William M. Perry  <wmperry@aventail.com>
+
+       * gtk-glue.c (face_to_style): DOH!  You should only load it if
+       IMAGE_INSTANCEP, not !IMAGE_INSTANCEP you doofus.
+
+       * ui-byhand.c (Fgtk_toolbar_append_item): Hand-rolled function.
+
+       * ui-gtk.c (Fgtk_import_function_internal): No longer need to use
+       dll_function() to get the marshallers.  They are now stored in a
+       hashtable.  Lookups should be a bit quicker, and it will work on
+       platforms where you cannot do a dll_open (NULL) to look at your
+       own symbol table.
+
+2000-05-31  William M. Perry  <wmperry@aventail.com>
+
+       * select-gtk.c (emacs_gtk_selection_handle): Better MULE string
+       handling.
+
+       * gtk-xemacs.c (gtk_xemacs_realize): Make sure we set the style on
+       the widget from the realize function.  Otherwise for some themes
+       the color slots are not allocated yet, and we end up with icky
+       looking colors for things like the modeline/toolbar.
+
+       * select-gtk.c (Fgtk_get_clipboard): If we cannot get the
+       selection from anyone, return the last selection we received.
+       This make us work more like the X selection behaviour with
+       cutbuffers enabled.
+
+2000-05-30  William M. Perry  <wmperry@aventail.com>
+
+       * ui-byhand.c: Removed definitions of gtk-clist-prepend,
+       gtk-clist-append, and gtk-clist-insert.
+
+       * ui-gtk.c (lisp_to_gtk_type): Use it.
+
+       * gtk-glue.c (face_to_style): Routine to convert from faces to
+       GtkStyle
+
+       * menubar-gtk.c (gtk_popup_menu): Honor popup_up_p here.
+       (popdown_menu_cb): and here.
+
+2000-05-29  William M. Perry  <wmperry@aventail.com>
+
+       * frame-gtk.c (gtk_popup_frame): Do not show the widgets if we
+       were told to be initially unmapped.
+       (gtk_init_frame_1): Remember whether we were told to be initially
+       unmapped.  Balloon help looks a little better now.
+
+2000-05-28  William M. Perry  <wmperry@aventail.com>
+
+       * redisplay-gtk.c (gtk_output_string): Fixed multi-dimensional
+       text run drawing.  gdk_draw_text does too much, by dividing the
+       length by 2.  So we fake them out my multiplying the length by the
+       dimension of the text.  This will do the right thing for
+       single-dimension runs as well of course.
+
+2000-05-26  William M. Perry  <wmperry@aventail.com>
+
+       * ui-gtk.c (get_enumeration): Utility function that does its best
+       to import unknown enumeration types.
+
+       * glyphs-gtk.c (resource_symbol_to_type): Fixed pointer
+       instantiation.
+
+       * gtk-xemacs.c (FROB_FACE): Make sure to pass the device to
+       Fmake_image_instance or the initial background pixmaps would not
+       show up.
+
+2000-05-25  William M. Perry  <wmperry@aventail.com>
+
+       * device-gtk.c (gtk_init_device): Call gnome_init if available.
+
+       * menubar-gtk.c (create_menubar_widget): Use gnome_app_set_menus
+       instead of dealing with all the handlebox/menu crap ourselves.
+
+       * frame-gtk.c (gtk_create_widgets): Use GnomeApp if it is
+       available.  Looks much sexier. :)
+
+       * glyphs-gtk.c (gtk_resource_instantiate): New image instantiator
+       gtk-resource, similar to the mswindows-resource stuff.  This
+       allows you to get to the stock cursors defined in GDK.  May
+       eventually allow you access to things like stock gnome pixmaps,
+       not sure.
+
+       * frame-gtk.c (gtk_set_frame_pointer): Actually handle setting the
+       frame cursor.
+
+       * redisplay-gtk.c (gdk_draw_bitmap): New function to output a
+       bitmap using XCopyPlane instead of XCopyArea.
+       (gtk_output_gdk_pixmap): Use it when PIXMAP_DEPTH == 0.  This
+       means bitmaps look correct now.
+
+2000-05-24  William M. Perry  <wmperry@aventail.com>
+
+       * ui-gtk.c (flags_to_list): New function to convert a GtkFlags
+       argument to a list of symbols.
+       (gtk_type_to_lisp): Use it for converting from a flag.
+
+2000-05-23  William M. Perry  <wmperry@aventail.com>
+
+       * frame-gtk.c (gtk_set_frame_position): Do not use
+       gtk_window_reposition - this apparently does not exist in some
+       versions of GTK 1.2
+
+       * gtk-glue.c (xemacs_gtklist_to_list): Don't call g_list_foreach
+       on a NULL list, just in case.
+
+       * redisplay-gtk.c (gtk_text_width_single_run): Use gdk_text_width
+       instead of gdk_text_measure.  Proportional fonts appear to work
+       now.
+
+       * objects-gtk.c (gtk_initialize_font_instance): Use X specific
+       crap lifted from objects-x.c to figure out proportionality of a
+       font, and better location of the default character.
+
+2000-05-22  William M. Perry  <wmperry@aventail.com>
+
+       * ui-gtk.c (enum_to_symbol): Routine to convert an enum to a lisp
+       symbol.  We now return this instead of an integer for GtkFlags or
+       GtkEnum types.
+       (lisp_to_flag): Routine to convert from a symbol or list of
+       symbols to a GtkEnum or GtkFlags type.
+       (lisp_to_gtk_type): Use it exclusively.  No more sending integers
+       to functions.
+       (import_gtk_enumeration_internal): Do not import the GTK_FOO_BAR
+       flags/enums into the lisp namespace.  We now store mappings from
+       symbol names (both the 'real' and nickname fields) to the actual
+       internal values.  Much more lispy way of doing things.
+
+       * menubar-gtk.c (__maybe_destroy): If we delete the menu item that
+       was 'active' when the menu was cancelled, GTK gets upset because
+       it tries to remove the focus rectangle from a (now) dead widget.
+       This widget will eventually get killed because it will not be
+       `precious' the next time the window is shown, because it is
+       unselectable.
+
+       * frame-gtk.c (delete_event_cb): Signal a fake event to make the
+       event loop wake up and notice we've been destroyed.
+
+2000-05-20  William M. Perry  <wmperry@aventail.com>
+
+       * ui-gtk.c (object_putprop): Allow `put'ing of arbitrary slots on
+       gtk objects.  This will be useful for tacking lisp shit onto
+       composite widgets, etc.
+       (object_getprop): Ditto for `get'ing.
+
+       * frame-gtk.c (gtk_set_initial_frame_size): Don't delay when
+       changing the frame size, or creating initially unmapped frames is
+       screwed up.  This showed up when trying to use the cheesy XEmacs
+       file selector dialog implemented using frames.
+
+       * ui-byhand.c: Removed a lot of functions that can now be imported
+       directly by gtk-import-function using the
+       Gtk(Array|List)Of(String|Object) types.
+
+       * ui-gtk.c (type_to_marshaller_type): Deal with new array/list
+       types.
+       (Fgtk_call_function): Need to free array and list storage after
+       calling functions.
+       (lisp_to_gtk_type): Deal with the new list and array types when
+       converting to GTK types.
+
+       * gtk-glue.c: New file to deal with lists of strings or
+       GtkObjects.  Defines new types GtkArrayOf, GtkListOf,
+       GtkArrayOfString, GtkListOfString, and GtkListOfObject.
+       (xemacs_list_to_array): Convert from a lisp list to a GtkArrayOf
+       of items.
+       (xemacs_list_to_list): Convert from a lisp list to a GtkListOf of
+       items.
+
+       * dialog.c (Fpopup_dialog_box): Don't crap out if the car of
+       dbox_desc is not a string... this allows us to follow ben's
+       system/native dialog box specification.
+
+2000-05-19  William M. Perry  <wmperry@aventail.com>
+
+       * ui-gtk.c (lisp_to_gtk_type): Can now convert to GDK colors.  Can
+       deal with color specifiers or instances.
+       (lisp_to_gtk_type): Can now convert to GDK fonts.  Can deal with
+       face names, actual faces, font specifiers, or font instances.
+
+2000-05-18  William M. Perry  <wmperry@aventail.com>
+
+       * gtk-xemacs.c (smash_scrollbar_specifiers): Function that
+       attempts to set the scrollbar width/height correctly, but does not
+       do a very good job.  Commented out for now.
+
+       * redisplay-gtk.c (gtk_output_vertical_divider): Got rid of lots
+       of useless code, since we ended up just calling gtk_output_shadows
+       anyway.
+       (gtk_output_vertical_divider): Make sure we fill the rectangle
+       completely, otherwise the transparent background shows thru.
+
+       * menubar-gtk.c: Don't nuke menus all the time... should speed up
+       submenu traversal a bit, and save on the GtkMenuItem creation.
+
+       * device-gtk.c (Fgtk_style_info): Return a list of all the
+       pixmaps, not just GTK_STATE_NORMAL.
+
+       * menubar-gtk.c (menu_descriptor_to_widget_1): Better menu labels
+       with keybindings.
+
+       * frame-gtk.c (gtk_set_frame_size): This function actually works
+       now.
+       (gtk_set_initial_frame_size): Better default sizing method.
+
+       * event-gtk.c (init_event_gtk_late): Push an error trap handler so
+       that XEmacs won't abort at the drop of a hat on X errors.  We
+       could get X specific here and override the default GDK XError and
+       XIOError handlers to be more like those in device-x.c.  Not sure
+       if that is worth it or not - you would at least get information
+       that an error occurred.
+
+       * scrollbar-gtk.c (gtk_update_scrollbar_instance_status): Don't
+       always call gtk_widget_set_usize because that causes the widget to
+       redraw itself, which can cause some annoying flicker.
+       (gtk_update_scrollbar_instance_status): Don't always move it
+       either, because that can cause the GtkFixed container to get a
+       resize event.
+       (update_one_widget_scrollbar_pointer): Try to set the cursor 
+
+2000-05-17  William M. Perry  <wmperry@aventail.com>
+
+       * device-gtk.c (Fgtk_style_info): Back to taking only 1 argument -
+       the device.
+       (Fgtk_style_info): Now returns ALL of the information about
+       colors.  Returns a list of colors instead of just the one
+       associated with GTK_STATE_NORMAL.
+
+2000-05-16  William M. Perry  <wmperry@aventail.com>
+
+       * gtk-xemacs.c (smash_face_fallbacks): New function to reset the
+       gtk-specific fallbacks on various face specifiers.  This means
+       that if the user has not changed the face, when a theme or style
+       is changed, the faces will automatically change as well.
+       (gtk_xemacs_style_set): Call it.
+
+       * toolbar-gtk.c (get_toolbar_gc): Swap the fg/bg of the toolbar
+       face when getting the GC.  It looks better this way.
+
+       * gtk-xemacs.c (gtk_xemacs_style_set): Override the style-set
+       method so that we can nuke the pixmaps again.
+       (__nuke_background_items): Moved the voodoo out into its own
+       function so that it can be called from both style_set and
+       realize.
+
+       * console-gtk.h (struct gtk_frame): Removed hardcoded GCs ala X.
+
+       * toolbar-gtk.c (get_toolbar_gc): New function that dynamically
+       creates a GC from the `toolbar' face.
+       (gtk_draw_blank_toolbar_button): Use it instead of the hardcoded
+       GC.
+       (gtk_output_toolbar_button): Ditto.
+       (gtk_output_toolbar): Ditto.
+
+       * event-gtk.c (gtk_check_for_quit_char): Quit handling actually
+       works now.  Feh!
+
+       * device-gtk.c (gtk_device_init_x_specific_cruft): New function
+       that gets the socket we are listening to the X server on so that
+       the SIGIO lossage works correctly for GTK devices.
+       (gtk_init_device): Call it at device creation time.
+
+2000-05-15  William M. Perry  <wmperry@aventail.com>
+
+       * ui-gtk.c (__internal_callback_marshal): We now correctly handle
+       the 'data' argument.  This is an arbitrary lisp object passed to
+       the callback routine as its last argument.
+
+2000-05-14  William M. Perry  <wmperry@aventail.com>
+
+       * event-gtk.c (gtk_event_to_emacs_event): Needed to reinstate the
+       magic to NOT differentiate betwen ! and shift-!.  *sigh*
+
+       * ui-gtk.c (lisp_to_gtk_type): Allow 'nil' for string types so
+       that we can pass NULL to gtk-frame-new.
+
+2000-05-13  William M. Perry  <wmperry@aventail.com>
+
+       * gtk-xemacs.c (gtk_xemacs_size_request): Needed to override the
+       size_request method to get frame sizing correct.  Whoo hoo!
+       (gtk_xemacs_realize): Don't set the background on the GtkXEmacs
+       window - this reduces the flicker even more.
+
+       * device-gtk.c (gtk_init_device): Don't use shared memory under
+       FreeBSD - it is apparently flaky as hell and causes lots of themes
+       to crash and burn quite prettily.
+
+       * gtk-xemacs.c (gtk_xemacs_realize): Added new widget method that
+       makes sure to nuke the background pixmap of the XEmacs text area
+       and its parent (the GtkWindow it is contained in).  This fixes the
+       flashing you would see with themes/styles that define a background
+       pixmap.
+
+2000-05-12  William M. Perry  <wmperry@aventail.com>
+
+       * menubar-gtk.c (gtk_update_frame_menubar_internal): Duh, should
+       actually pay attention to menubar_will_be_visible instead of just
+       calling gtk_widget_show_all in both branches. :)
+
+2000-05-11  William M. Perry  <wmperry@aventail.com>
+
+       * menubar-gtk.c (vars_of_menubar_gtk): New variable
+       menubar-dockable-p that controls whether to use the GtkHandleBox
+       or not.
+
+       * select-gtk.c: Implemented all of the selection callbacks for GTK
+
+       * frame-gtk.c (resize_event_cb): Force a redisplay when the frame
+       is resized.
+
+       * event-gtk.c (gtk_event_to_emacs_event): When we are doing our
+       hackery to make sure we don't see button events inside the
+       scrollbar, make sure we correctly forward events that did not
+       happen over ANY widget, otherwise selection gets royally screwed
+       and thinks you still have the mouse button down.
+
+       * redisplay-gtk.c (gtk_output_string): Don't bother calling
+       gdk_draw_text_wc - I misunderstood what XDrawString16 did -
+       gdk_draw_text encapsulates this nicely for us.
+
+2000-05-10  William M. Perry  <wmperry@aventail.com>
+
+       * menubar-gtk.c: Changed how the menubar is created and managed.
+       We no longer create and destroy it at will.  Only one GtkMenuBar
+       is ever created, and the children are just added/removed from it.
+       Much less flickering when switching buffers - cleaner in general.
+       (create_menubar_widget): Wheee - menubars are now detachable.
+
+       * ui-gtk.c (Fgtk_import_function_internal): Don't drop everything
+       down to its fundamental type just yet - we need to know specifics
+       about boxed types.
+       (object_putprop): Duh, actually SET the property.
+       (Fgtk_fundamental_type): New function that does the obvious.
+       (Fgtk_object_type): New function that does the obvious.
+       (lisp_to_gtk_type): Implement glyph handling!  GtkPixmap works!
+
+       * ui-byhand.c (Fgtk_pixmap_get): Implemented by hand.  *sigh*
+
+       * dialog-gtk.c: Call into lisp to do dialog boxes.
+
+2000-05-08  William M. Perry  <wmperry@aventail.com>
+
+       * make-src-depend (PrintPatternDeps): Make sure we generate the
+       xx-gtk.* dependencies.
+
+       * depend: Regenerated 
+
+       * make-src-depend: Handle inclusion of .c files.
+
+       * Makefile.in.in (extra_doc_files): Need to include ui-byhand.c
+       here as well.
+
+       * ui-gtk.c (type_to_marshaller_type): Don't abort if we don't know
+       about the marshaller.  Just return Qnil and let the caller figure
+       it out.
+       (Fgtk_import_function_internal): Deal with new return value of
+       Qnil for error signalling from type_to_marshaller_type().
+       (lisp_to_gtk_type): Half-assed implementation of dealing with
+       callbacks.
+       (gtk_type_to_lisp): Ditto.
+
+       * ui-byhand.c: New file that hand-codes some annoying functions in
+       Gtk.  *sigh*
+
+       * emacs-widget-accessors.c (Fgtk_adjustment_lower): New
+       auto-generated file that spits out all the widget slot accessor
+       functions.
+
+       * ui-gtk.c (Fgtk_signal_connect_internal): Holy shit, signals work!
+       (lisp_to_gtk_type): Allow ints to be passed in as arguments to
+       functions that expect floats, otherwise you have to write stupid
+       code like 9.0 instead of just passing in '9'.
+
+2000-05-07  William M. Perry  <wmperry@aventail.com>
+
+       * ui-gtk.c (gtk_type_to_lisp): Return Qnil if we get a NULL
+       pointer/object/boxed.
+       (lisp_to_gtk_type): Allow Qnil to be passed in to mean a NULL
+       pointer/object/boxed.
+
+       * event-gtk.c (gtk_event_to_emacs_event): Make sure a button press
+       focuses on the text widget, otherwise if someone packs a widget
+       into the container from lisp, we end up not getting keyboard focus
+       quite a bit.  Eek.
+
+       * frame-gtk.c (gtk_create_widgets): Set the name of the xemacs
+       shell so we can control sylte issues from .gtkrc
+       (gtk_set_initial_frame_size): Set the default size of the frame
+       correctly.
+       (gtk_create_widgets): Expose the frame shell and container widgets
+       to lisp.
+
+       * emacs-marshals.c: Added a whole shitload of marshallers - don't
+       edit this file by hand if you need to add one.  Check out
+       ../lisp/ui/gtk-marshal.el for a script that auto-generates them
+       for you.
+
+2000-05-05  William M. Perry  <wmperry@aventail.com>
+
+       * ui-gtk.c (describe_gtk_arg): Debugging function to spit out
+       human-readable version a GtkArg.
+       (lisp_to_gtk_type): Made this function much more sane.
+       (Fgtk_call_function): New function to allow calling generic
+       functions from DLLs in lisp.
+       (CONVERT_RETVAL): New macro (ugh) to convert a pointer that the
+       return value filled in back into a valid GtkArg.
+       (Fgtk_call_function): This actually works now!  Scary stuff.
+
+2000-05-04  William M. Perry  <wmperry@aventail.com>
+
+       * ui-gtk.c (Fgtk_import_type): New function to import a GtkType
+       into the XEmacs namespace.  For starters this only fully imports
+       enumerations and flags.  Importing a GtkObject or subclass results
+       in getting a list back of possible signals and argument lists.
+
+       * scrollbar-gtk.c (gtk_create_scrollbar_instance): Fixed some
+       compiler warnings.
+       (scrollbar_cb): Aha!  Thanks to the magic of reading the
+       gtkrange.c source code, we now have better behaving scrollbars.
+       Clicking in the trough/end arrows now works correctly instead of
+       the semi-hackish way it did earlier today.
+
+       * ui-gtk.c (Fgtk_define_enumeration): New function that can 
+
+       * scrollbar-gtk.c (scrollbar_cb): Combined the horizontal and
+       vertical scrolling callbacks.  Differentiate between them by
+       user_data. 
+       (scrollbar_cb): Don't bother trying to figure out whether this is
+       a line-by-line or page-wide scrolling operation.  Just go by what
+       is in the value of the adjustment and issue a scrollbar_*_drag
+       event.  This is not 100% correct, but it at least gets it
+       working.  Doing it 'right' might not be possible with standard Gtk
+       scrollbars.
+       (scrollbar_drag_hack_cb): New function to set
+       vertical_drag_in_progress and inhibit_slider_change when we might
+       be starting a drag in the scrollbar.
+       (gtk_update_scrollbar_instance_status): Better setting of the
+       adjustment variables.  Scrolling by pages (clicking in the trough)
+       works now.  Line-by-line seems to work too.
+
+2000-05-03  William M. Perry  <wmperry@aventail.com>
+
+       * scrollbar-gtk.c (gtk_update_scrollbar_instance_status): Got the
+       thumb sizing correct finally.  Thanks to scrollbar-msw.c for
+       showing how to do it sanely - scrollbar-x.c is a mess.
+
+       * window.c (specifier_vars_of_window): Added GTK specific fallback
+       for Vvertical_divider_line_width.
+
+       * toolbar.c (specifier_vars_of_toolbar): Handle specifier
+       fallbacks for GTK toolbars.
+
+       * gui-gtk.c (button_item_to_widget): Compiles under Gtk at least -
+       more than likely completely broken.
+
+       * glyphs-gtk.c (write_lisp_string_to_temp_file): Resurrected this
+       blasphemous function to deal with XPMs.
+       (gtk_xpm_instantiate): Now writes the XPM to a temp file, since
+       GTK cannot deal with XPMs from memory.  Lame, but not fixable for
+       gtk 1.2 - maybe for 1.4.
+       (gtk_xpm_instantiate): Transparency works now.
+
+       * gccache-gtk.c (gc_cache_lookup): Made non-hash based code
+       compile.  It is not used, but what the hell.
+
+       * faces.c (complex_vars_of_faces): Do GTK specific mucking about
+       with face property fallbacks (fonts and colors)
+
+       * events.c (event_equal): Added special case for GTK.
+       (event_hash): Added special case for GTK.
+       (format_event_object): Added special case for GTK events.
+
+       * event-gtk.c (event_name): Use gtk_event_name helper function
+       here.
+       (handle_focus_event_1): Got rid of gtk-redisplay-hack variable and
+       usage.
+
+       * device.c (delete_device_internal): Delete 'popup' frames under
+       Gtk as well as X.  Should this happen for HAVE_MSWINDOWS as well?
+
+       * console.c (select_console_1): Make sure we set Vwindow_system
+       like all the others.
+
+       * frame-gtk.c (gtk_update_frame_external_traits): Added comments
+       about why I didn't implement some portions of this function.
+
+       * redisplay-gtk.c (gtk_output_string): Fixed the bizarre redisplay
+       problem where all the default text would be drawn twice - once
+       with the normal background colour, and once with the text-cursor
+       background.  This was caused by a stupid typo and using the wrong
+       GdkGC in the second call to gdk_draw_text_image... basically no
+       clipping was being done on the image, so the whole thing was
+       redrawn.
+       (gtk_output_string): Call gdk_draw_text if we have a background
+       pixmap, otherwise things look REALLY weird.
+       (gtk_clear_region): Had a misplaced brace that caused the non-text
+       area of a frame not to get the correct background.
+
+2000-05-02  William M. Perry  <wmperry@aventail.com>
+
+       * glyphs-gtk.c (gtk_xpm_instantiate): Need to write pixmaps to a
+       temp file and then read with gdk_pixmap_create_from_xpm () - there
+       is no way to read from a memory buffer (yet - I might write one
+       for Gtk 1.4)
+
+       * glyphs.c: Don't include xpm.h when building with Gtk.
+       (pixmap_to_lisp_data): Alternate implementation for Gtk.
+
+       * device-gtk.c (gtk_init_device): Call gdk_imlib_init if
+       available, otherwise the 'Pixmap' theme engine doesn't work.
+       Losers.
+
+       * glyphs-gtk.c (gtk_xpm_instantiate): Now at least tries to
+       instantiate XPM images.
+       (init_image_instance_from_gdk_pixmap): Utility function to create
+       a glyph from an existing GdkPixmap.
+
+       * device-gtk.c (Fgtk_style_info): Attempt to expose the background
+       pixmaps from a Gtk style.
+

diff --git a/src/console-gtk.c b/src/console-gtk.c
new file mode 100644 (file)
index 0000000..d5343cc
--- /dev/null
+++ b/src/console-gtk.c
@@ -0,0 +1,129 @@
+/* Console functions for X windows.
+   Copyright (C) 1996 Ben Wing.
+
+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, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with: Not in FSF. */
+
+/* Authorship:
+
+   Ben Wing: January 1996, for 19.14.
+   William Perry: April 2000, for 21.1 (Gtk version)
+ */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "console-gtk.h"
+#include "process.h" /* canonicalize_host_name */
+#include "redisplay.h" /* for display_arg */
+
+DEFINE_CONSOLE_TYPE (gtk);
+
+static int
+gtk_initially_selected_for_input (struct console *con)
+{
+  return 1;
+}
+
+/* Remember, in all of the following functions, we have to verify
+   the integrity of our input, because the generic functions don't. */
+
+static Lisp_Object
+gtk_device_to_console_connection (Lisp_Object connection, Error_behavior errb)
+{
+  /* Strip the trailing .# off of the connection, if it's there. */
+
+  if (NILP (connection))
+    return Qnil;
+  else
+    {
+       connection = build_string ("gtk");
+    }
+  return connection;
+}
+
+static Lisp_Object
+gtk_semi_canonicalize_console_connection (Lisp_Object connection,
+                                         Error_behavior errb)
+{
+  struct gcpro gcpro1;
+
+  GCPRO1 (connection);
+
+  connection = build_string ("gtk");
+
+  RETURN_UNGCPRO (connection);
+}
+
+static Lisp_Object
+gtk_canonicalize_console_connection (Lisp_Object connection, Error_behavior errb)
+{
+  Lisp_Object hostname = Qnil;
+  struct gcpro gcpro1, gcpro2;
+
+  GCPRO2 (connection, hostname);
+
+  connection = build_string ("gtk");
+
+  RETURN_UNGCPRO (connection);
+}
+
+static Lisp_Object
+gtk_semi_canonicalize_device_connection (Lisp_Object connection,
+                                        Error_behavior errb)
+{
+  struct gcpro gcpro1;
+
+  GCPRO1 (connection);
+
+  connection = build_string("gtk");
+
+  RETURN_UNGCPRO (connection);
+}
+
+static Lisp_Object
+gtk_canonicalize_device_connection (Lisp_Object connection, Error_behavior errb)
+{
+  struct gcpro gcpro1;
+
+  GCPRO1 (connection);
+  connection = build_string("gtk");
+
+  RETURN_UNGCPRO (connection);
+}
+
+void
+console_type_create_gtk (void)
+{
+  INITIALIZE_CONSOLE_TYPE (gtk, "gtk", "console-gtk-p");
+
+  CONSOLE_HAS_METHOD (gtk, semi_canonicalize_console_connection);
+  CONSOLE_HAS_METHOD (gtk, canonicalize_console_connection);
+  CONSOLE_HAS_METHOD (gtk, semi_canonicalize_device_connection);
+  CONSOLE_HAS_METHOD (gtk, canonicalize_device_connection);
+  CONSOLE_HAS_METHOD (gtk, device_to_console_connection);
+  CONSOLE_HAS_METHOD (gtk, initially_selected_for_input);
+  /* CONSOLE_HAS_METHOD (gtk, delete_console); */
+}
+
+void
+reinit_console_type_create_gtk (void)
+{
+  REINITIALIZE_CONSOLE_TYPE (gtk);
+}

diff --git a/src/console-gtk.h b/src/console-gtk.h
new file mode 100644 (file)
index 0000000..31c5055
--- /dev/null
+++ b/src/console-gtk.h
@@ -0,0 +1,243 @@
+/* Define X specific console, device, and frame object for XEmacs.
+   Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+   Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
+
+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, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with: Not in FSF. */
+
+
+/* Authorship:
+
+   Ultimately based on FSF, then later on JWZ work for Lemacs.
+   Rewritten over time by Ben Wing and Chuck Thompson (original
+      multi-device work by Chuck Thompson).
+ */
+
+#ifndef _XEMACS_CONSOLE_GTK_H_
+#define _XEMACS_CONSOLE_GTK_H_
+
+#ifdef HAVE_GTK
+
+#include "console.h"
+#include <gtk/gtk.h>
+
+#define GDK_DRAWABLE(x) (GdkDrawable *) (x)
+#define GET_GTK_WIDGET_WINDOW(x) (GTK_WIDGET (x)->window)
+#define GET_GTK_WIDGET_PARENT(x) (GTK_WIDGET (x)->parent)
+
+DECLARE_CONSOLE_TYPE (gtk);
+
+struct gtk_device
+{
+  /* Gtk application info. */
+  GtkWidget *gtk_app_shell;
+
+  /* Cache of GC's for frame's on this device. */
+  struct gc_cache *gc_cache;
+
+  /* Selected visual, depth and colormap for this device */
+  GdkVisual *visual;
+  int depth;
+  GdkColormap *device_cmap;
+
+  /* Used by x_bevel_modeline in redisplay-x.c */
+  GdkBitmap *gray_pixmap;
+
+  /* frame that holds the WM_COMMAND property; there should be exactly
+     one of these per device. */
+  Lisp_Object WM_COMMAND_frame;
+
+  /* The following items are all used exclusively in event-gtk.c. */
+  int MetaMask, HyperMask, SuperMask, AltMask, ModeMask;
+  guint lock_interpretation;
+
+  void *x_modifier_keymap; /* Really an (XModifierKeymap *)*/
+
+  guint *x_keysym_map;
+  int x_keysym_map_min_code;
+  int x_keysym_map_max_code;
+  int x_keysym_map_keysyms_per_code;
+  Lisp_Object x_keysym_map_hashtable;
+
+  /* #### It's not clear that there is much distinction anymore
+     between mouse_timestamp and global_mouse_timestamp, now that
+     Emacs doesn't see most (all?) events not destined for it. */
+
+  /* The timestamp of the last button or key event used by emacs itself.
+     This is used for asserting selections and input focus. */
+  guint32 mouse_timestamp;
+
+  /* This is the timestamp the last button or key event whether it was
+     dispatched to emacs or widgets. */
+  guint32 global_mouse_timestamp;
+
+  /* This is the last known timestamp received from the server.  It is
+     maintained by x_event_to_emacs_event and used to patch bogus
+     WM_TAKE_FOCUS messages sent by Mwm. */
+  guint32 last_server_timestamp;
+
+  GdkAtom atom_WM_PROTOCOLS;
+  GdkAtom atom_WM_TAKE_FOCUS;
+  GdkAtom atom_WM_STATE;
+
+#if 0
+       /* #### BILL!!! */
+  /* stuff for sticky modifiers: */
+  unsigned int need_to_add_mask, down_mask;
+  KeyCode last_downkey;
+  guint32 release_time;
+#endif
+};
+
+#define DEVICE_GTK_DATA(d) DEVICE_TYPE_DATA (d, gtk)
+
+#define DEVICE_GTK_VISUAL(d)   (DEVICE_GTK_DATA (d)->visual)
+#define DEVICE_GTK_DEPTH(d)    (DEVICE_GTK_DATA (d)->depth)
+#define DEVICE_GTK_COLORMAP(d)         (DEVICE_GTK_DATA (d)->device_cmap)
+#define DEVICE_GTK_APP_SHELL(d)        (DEVICE_GTK_DATA (d)->gtk_app_shell)
+#define DEVICE_GTK_GC_CACHE(d)         (DEVICE_GTK_DATA (d)->gc_cache)
+#define DEVICE_GTK_GRAY_PIXMAP(d) (DEVICE_GTK_DATA (d)->gray_pixmap)
+#define DEVICE_GTK_WM_COMMAND_FRAME(d) (DEVICE_GTK_DATA (d)->WM_COMMAND_frame)
+#define DEVICE_GTK_MOUSE_TIMESTAMP(d)  (DEVICE_GTK_DATA (d)->mouse_timestamp)
+#define DEVICE_GTK_GLOBAL_MOUSE_TIMESTAMP(d) (DEVICE_GTK_DATA (d)->global_mouse_timestamp)
+#define DEVICE_GTK_LAST_SERVER_TIMESTAMP(d)  (DEVICE_GTK_DATA (d)->last_server_timestamp)
+
+/* The maximum number of widgets that can be displayed above the text
+   area at one time.  Currently no more than 3 will ever actually be
+   displayed (menubar, psheet, debugger panel). */
+#define MAX_CONCURRENT_TOP_WIDGETS 8
+
+struct gtk_frame
+{
+  /* The widget of this frame. */
+  GtkWidget *widget;           /* This is really a GtkWindow */
+
+  /* The layout manager */
+  GtkWidget *container;                /* actually a GtkVBox. */
+
+  /* The widget of the menubar */
+  GtkWidget *menubar_widget;
+
+  /* The widget of the edit portion of this frame; this is a GtkDrawingArea,
+     and the window of this widget is what the redisplay code draws on. */
+  GtkWidget *edit_widget;
+
+  /* Lists the widgets above the text area, in the proper order. */
+  GtkWidget *top_widgets[MAX_CONCURRENT_TOP_WIDGETS];
+  int num_top_widgets;
+
+  /* Our container widget as a Lisp_Object */
+  Lisp_Object lisp_visible_widgets[10];
+
+  /*************************** Miscellaneous **************************/
+
+  /* The icon pixmaps; these are Lisp_Image_Instance objects, or Qnil. */
+  Lisp_Object icon_pixmap;
+  Lisp_Object icon_pixmap_mask;
+
+  /* geometry string that ought to be freed. */
+  char *geom_free_me_please;
+
+  /* 1 if the frame is completely visible on the display, 0 otherwise.
+     if 0 the frame may have been iconified or may be totally
+     or partially hidden by another X window */
+  unsigned int totally_visible_p :1;
+
+    /* Is it visible at all? */
+  unsigned int visible_p :1;
+
+  /* Are we a top-level frame?  This means that our shell is a
+     TopLevelShell, and we should do certain things to interact with
+     the window manager. */
+  unsigned int top_level_frame_p :1;
+
+  /* Are we iconfied right now? */
+  unsigned int iconified_p :1;
+
+};
+
+#define FRAME_GTK_DATA(f) FRAME_TYPE_DATA (f, gtk)
+
+#define FRAME_GTK_SHELL_WIDGET(f)          (FRAME_GTK_DATA (f)->widget)
+#define FRAME_GTK_CONTAINER_WIDGET(f) (FRAME_GTK_DATA (f)->container)
+#define FRAME_GTK_MENUBAR_WIDGET(f)   (FRAME_GTK_DATA (f)->menubar_widget)
+#define FRAME_GTK_TEXT_WIDGET(f)           (FRAME_GTK_DATA (f)->edit_widget)
+#define FRAME_GTK_TOP_WIDGETS(f)           (FRAME_GTK_DATA (f)->top_widgets)
+#define FRAME_GTK_NUM_TOP_WIDGETS(f)     (FRAME_GTK_DATA (f)->num_top_widgets)
+#define FRAME_GTK_ICONIFIED_P(f)         (FRAME_GTK_DATA (f)->iconfigied_p)
+
+#define FRAME_GTK_LISP_WIDGETS(f)      (FRAME_GTK_DATA (f)->lisp_visible_widgets)
+#define FRAME_GTK_ICON_PIXMAP(f)           (FRAME_GTK_DATA (f)->icon_pixmap)
+#define FRAME_GTK_ICON_PIXMAP_MASK(f) (FRAME_GTK_DATA (f)->icon_pixmap_mask)
+
+#define FRAME_GTK_GEOM_FREE_ME_PLEASE(f) (FRAME_GTK_DATA (f)->geom_free_me_please)
+
+#define FRAME_GTK_TOTALLY_VISIBLE_P(f) (FRAME_GTK_DATA (f)->totally_visible_p)
+#define FRAME_GTK_VISIBLE_P(f) (FRAME_GTK_DATA (f)->visible_p)
+#define FRAME_GTK_TOP_LEVEL_FRAME_P(f) (FRAME_GTK_DATA (f)->top_level_frame_p)
+
+/* Variables associated with the X display frame this emacs is using. */
+
+extern Lisp_Object Vx_gc_pointer_shape;
+extern Lisp_Object Vx_scrollbar_pointer_shape;
+
+extern struct console_type *gtk_console_type;
+extern Lisp_Object Vdefault_gtk_device;
+
+/* Number of pixels below each line. */
+extern int gtk_interline_space;
+
+extern int gtk_selection_timeout;
+
+struct frame *gtk_any_window_to_frame (struct device *d, GdkWindow *);
+struct frame *gtk_window_to_frame (struct device *d, GdkWindow *);
+struct frame *gtk_any_widget_or_parent_to_frame (struct device *d, GtkWidget *widget);
+struct frame *decode_gtk_frame (Lisp_Object);
+struct device *gtk_any_window_to_device (GdkWindow *);
+struct device *decode_gtk_device (Lisp_Object);
+void gtk_handle_property_notify (GdkEventProperty *event);
+
+void signal_special_gtk_user_event (Lisp_Object channel, Lisp_Object function,
+                                   Lisp_Object object);
+void gtk_redraw_exposed_area (struct frame *f, int x, int y,
+                           int width, int height);
+void gtk_output_string (struct window *w, struct display_line *dl,
+                     Emchar_dynarr *buf, int xpos, int xoffset,
+                     int start_pixpos, int width, face_index findex,
+                     int cursor, int cursor_start, int cursor_width,
+                     int cursor_height);
+void gtk_output_gdk_pixmap (struct frame *f, struct Lisp_Image_Instance *p,
+                           int x, int y, int clip_x, int clip_y,
+                           int clip_width, int clip_height, int width,
+                           int height, int pixmap_offset,
+                           GdkColor *fg, GdkColor *bg,
+                           GdkGC *override_gc);
+void gtk_output_shadows (struct frame *f, int x, int y, int width,
+                      int height, int shadow_thickness);
+
+int gtk_initialize_frame_menubar (struct frame *f);
+void gtk_init_modifier_mapping (struct device *d);
+
+void Initialize_Locale (void);
+
+extern Lisp_Object Vgtk_initial_argv_list; /* #### ugh! */
+
+const char *gtk_event_name (GdkEventType event_type);
+#endif /* HAVE_GTK */
+#endif /* _XEMACS_DEVICE_X_H_ */

diff --git a/src/device-gtk.c b/src/device-gtk.c
new file mode 100644 (file)
index 0000000..408bc7f
--- /dev/null
+++ b/src/device-gtk.c
@@ -0,0 +1,755 @@
+/* Device functions for X windows.
+   Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
+   Copyright (C) 1994, 1995 Free Software Foundation, Inc.
+
+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, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with: Not in FSF. */
+
+/* Original authors: Jamie Zawinski and the FSF */
+/* Rewritten by Ben Wing and Chuck Thompson. */
+/* Gtk flavor written by William Perry */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "console-gtk.h"
+#include "gccache-gtk.h"
+#include "glyphs-gtk.h"
+#include "objects-gtk.h"
+#include "gtk-xemacs.h"
+
+#include "buffer.h"
+#include "events.h"
+#include "faces.h"
+#include "frame.h"
+#include "redisplay.h"
+#include "sysdep.h"
+#include "window.h"
+#include "elhash.h"
+
+#include "sysfile.h"
+#include "systime.h"
+
+#ifdef HAVE_GNOME
+#include <libgnomeui/libgnomeui.h>
+#endif
+
+#ifdef HAVE_BONOBO
+#include <bonobo.h>
+#endif
+
+Lisp_Object Vdefault_gtk_device;
+
+/* Qdisplay in general.c */
+Lisp_Object Qinit_pre_gtk_win, Qinit_post_gtk_win;
+
+/* The application class of Emacs. */
+Lisp_Object Vgtk_emacs_application_class;
+
+Lisp_Object Vgtk_initial_argv_list; /* #### ugh! */
+Lisp_Object Vgtk_initial_geometry;
+
+static void gtk_device_init_x_specific_cruft (struct device *d);
+
+\f
+/************************************************************************/
+/*                          helper functions                            */
+/************************************************************************/
+
+struct device *
+decode_gtk_device (Lisp_Object device)
+{
+  XSETDEVICE (device, decode_device (device));
+  CHECK_GTK_DEVICE (device);
+  return XDEVICE (device);
+}
+
+\f
+/************************************************************************/
+/*                   initializing a GTK connection                     */
+/************************************************************************/
+extern Lisp_Object
+xemacs_gtk_convert_color(GdkColor *c, GtkWidget *w);
+
+extern Lisp_Object __get_gtk_font_truename (GdkFont *gdk_font, int expandp);
+
+#define convert_font(f) __get_gtk_font_truename (f, 0)
+
+static void
+allocate_gtk_device_struct (struct device *d)
+{
+  d->device_data = xnew_and_zero (struct gtk_device);
+  DEVICE_GTK_DATA (d)->x_keysym_map_hashtable = Qnil;
+}
+
+static void
+gtk_init_device_class (struct device *d)
+{
+  if (DEVICE_GTK_DEPTH(d) > 2)
+    {
+      switch (DEVICE_GTK_VISUAL(d)->type)
+       {
+       case GDK_VISUAL_STATIC_GRAY:
+       case GDK_VISUAL_GRAYSCALE:
+         DEVICE_CLASS (d) = Qgrayscale;
+         break;
+       default:
+         DEVICE_CLASS (d) = Qcolor;
+       }
+    }
+  else
+    DEVICE_CLASS (d) = Qmono;
+}
+
+#ifdef HAVE_GDK_IMLIB_INIT
+extern void gdk_imlib_init(void);
+#endif
+
+extern void emacs_gtk_selection_handle (GtkWidget *,
+                                       GtkSelectionData *selection_data,
+                                       guint info,
+                                       guint time_stamp,
+                                       gpointer data);
+extern void emacs_gtk_selection_received (GtkWidget *widget,
+                                         GtkSelectionData *selection_data,
+                                         gpointer user_data);
+
+#ifdef HAVE_BONOBO
+static CORBA_ORB orb;
+#endif
+
+DEFUN ("gtk-init", Fgtk_init, 1, 1, 0, /*
+Initialize the GTK subsystem.
+ARGS is a standard list of command-line arguments.
+
+No effect if called more than once.  Called automatically when
+creating the first GTK device.  Must be called manually from batch
+mode.
+*/
+       (args))
+{
+  int argc;
+  char **argv;
+  static int done;
+
+  if (done)
+    {
+      return (Qt);
+    }
+
+  make_argc_argv (args, &argc, &argv);
+
+  slow_down_interrupts ();
+#ifdef HAVE_GNOME
+#ifdef INFODOCK
+  gnome_init ("InfoDock", EMACS_VERSION, argc, argv);
+#else
+  gnome_init ("XEmacs", EMACS_VERSION, argc, argv);
+#endif /* INFODOCK */
+#else
+  gtk_init (&argc, &argv);
+#endif
+
+#ifdef HAVE_BONOBO
+  orb = oaf_init (argc, argv);
+
+  if (bonobo_init (orb, NULL, NULL) == FALSE)
+    {
+      g_warning ("Could not initialize bonobo...");
+    }
+
+  bonobo_activate ();
+#endif
+
+  speed_up_interrupts ();
+
+  free_argc_argv (argv);
+  return (Qt);
+}
+
+static void
+gtk_init_device (struct device *d, Lisp_Object props)
+{
+  Lisp_Object device;
+  Lisp_Object display;
+  GtkWidget *app_shell = NULL;
+  GdkVisual *visual = NULL;
+  GdkColormap *cmap = NULL;
+
+  XSETDEVICE (device, d);
+
+  /* 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))
+    {
+      signal_simple_error ("gtk-initial-argv-list must be set before creating Gtk devices", Vgtk_initial_argv_list);
+      return;
+    }
+
+  allocate_gtk_device_struct (d);
+  display = DEVICE_CONNECTION (d);
+
+  /* Attempt to load a site-specific gtkrc */
+  {
+    Lisp_Object gtkrc = Fexpand_file_name (build_string ("gtkrc"), Vdata_directory);
+    gchar **default_files = gtk_rc_get_default_files ();
+    gint num_files;
+
+    if (STRINGP (gtkrc))
+      {
+       /* Found one, load it up! */
+       gchar **new_rc_files = NULL;
+       int ctr;
+
+       for (num_files = 0; default_files[num_files]; num_files++);
+
+       new_rc_files = xnew_array_and_zero (gchar *, num_files + 3);
+
+       new_rc_files[0] = XSTRING_DATA (gtkrc);
+       for (ctr = 1; default_files[ctr-1]; ctr++)
+         new_rc_files[ctr] = g_strdup (default_files[ctr-1]);
+
+       gtk_rc_set_default_files (new_rc_files);
+
+       for (ctr = 1; new_rc_files[ctr]; ctr++)
+         free(new_rc_files[ctr]);
+
+       xfree (new_rc_files);
+      }
+  }
+
+  Fgtk_init (Vgtk_initial_argv_list);
+
+#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)
+     that they rely on gdk_imlib, but don't call its initialization
+     routines.  This makes them USELESS for non-gnome applications.
+     So we bend over backwards to try and make them work.  Losers. */
+  gdk_imlib_init ();
+#endif
+
+  if (NILP (DEVICE_NAME (d)))
+    DEVICE_NAME (d) = display;
+
+  /* Always search for the best visual */
+  visual = gdk_visual_get_best();
+  cmap = gdk_colormap_new (visual, TRUE);
+
+  DEVICE_GTK_VISUAL (d) = visual;
+  DEVICE_GTK_COLORMAP (d) = cmap;
+  DEVICE_GTK_DEPTH (d) = visual->depth;
+
+  {
+    GtkWidget *w = gtk_window_new (GTK_WINDOW_TOPLEVEL);
+
+    app_shell = gtk_xemacs_new (NULL);
+    gtk_container_add (GTK_CONTAINER (w), app_shell);
+
+    gtk_widget_realize (w);
+  }
+
+  DEVICE_GTK_APP_SHELL (d) = app_shell;
+
+  /* Realize the app_shell so that its window exists for GC creation
+     purposes */
+  gtk_widget_realize (GTK_WIDGET (app_shell));
+
+  /* Need to set up some selection handlers */
+  gtk_selection_add_target (GTK_WIDGET (app_shell), GDK_SELECTION_PRIMARY,
+                           GDK_SELECTION_TYPE_STRING, 0);
+  
+  gtk_signal_connect (GTK_OBJECT (app_shell), "selection_get",
+                     GTK_SIGNAL_FUNC (emacs_gtk_selection_handle), NULL);
+  gtk_signal_connect (GTK_OBJECT (app_shell), "selection_received",
+                     GTK_SIGNAL_FUNC (emacs_gtk_selection_received), NULL);
+
+  DEVICE_GTK_WM_COMMAND_FRAME (d) = Qnil;
+
+  gtk_init_modifier_mapping (d);
+
+  gtk_device_init_x_specific_cruft (d);
+
+  init_baud_rate (d);
+  init_one_device (d);
+
+  DEVICE_GTK_GC_CACHE (d) = make_gc_cache (GTK_WIDGET (app_shell));
+  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 *d, Lisp_Object props)
+{
+  call0 (Qinit_post_gtk_win);
+}
+
+static void
+gtk_mark_device (struct device *d)
+{
+  mark_object (DEVICE_GTK_WM_COMMAND_FRAME (d));
+  mark_object (DEVICE_GTK_DATA (d)->x_keysym_map_hashtable);
+}
+
+\f
+/************************************************************************/
+/*                       closing an X connection                       */
+/************************************************************************/
+
+static void
+free_gtk_device_struct (struct device *d)
+{
+  xfree (d->device_data);
+}
+
+static void
+gtk_delete_device (struct device *d)
+{
+  Lisp_Object device;
+
+#ifdef FREE_CHECKING
+  extern void (*__free_hook)();
+  int checking_free;
+#endif
+
+  XSETDEVICE (device, d);
+  if (1)
+    {
+#ifdef FREE_CHECKING
+      checking_free = (__free_hook != 0);
+
+      /* Disable strict free checking, to avoid bug in X library */
+      if (checking_free)
+       disable_strict_free_check ();
+#endif
+
+      free_gc_cache (DEVICE_GTK_GC_CACHE (d));
+
+#ifdef FREE_CHECKING
+      if (checking_free)
+       enable_strict_free_check ();
+#endif
+    }
+
+  if (EQ (device, Vdefault_gtk_device))
+    {
+      Lisp_Object devcons, concons;
+      /* #### handle deleting last X device */
+      Vdefault_gtk_device = Qnil;
+      DEVICE_LOOP_NO_BREAK (devcons, concons)
+       {
+         if (DEVICE_GTK_P (XDEVICE (XCAR (devcons))) &&
+             !EQ (device, XCAR (devcons)))
+           {
+             Vdefault_gtk_device = XCAR (devcons);
+             goto double_break;
+           }
+       }
+    }
+ double_break:
+  free_gtk_device_struct (d);
+}
+
+\f
+/************************************************************************/
+/*                             handle X errors                         */
+/************************************************************************/
+
+const char *
+gtk_event_name (GdkEventType event_type)
+{
+  GtkEnumValue *vals = gtk_type_enum_get_values (GTK_TYPE_GDK_EVENT_TYPE);
+
+  while (vals && (vals->value != event_type)) vals++;
+
+  if (vals)
+    return (vals->value_nick);
+
+  return (NULL);
+}
+
+\f
+/************************************************************************/
+/*                   display information functions                      */
+/************************************************************************/
+
+DEFUN ("default-gtk-device", Fdefault_gtk_device, 0, 0, 0, /*
+Return the default GTK device for resourcing.
+This is the first-created GTK device that still exists.
+*/
+       ())
+{
+  return Vdefault_gtk_device;
+}
+
+DEFUN ("gtk-display-visual-class", Fgtk_display_visual_class, 0, 1, 0, /*
+Return the visual class of the GTK display DEVICE is using.
+The returned value will be one of the symbols `static-gray', `gray-scale',
+`static-color', `pseudo-color', `true-color', or `direct-color'.
+*/
+       (device))
+{
+  GdkVisual *vis = DEVICE_GTK_VISUAL (decode_gtk_device (device));
+  switch (vis->type)
+    {
+    case GDK_VISUAL_STATIC_GRAY:  return intern ("static-gray");
+    case GDK_VISUAL_GRAYSCALE:    return intern ("gray-scale");
+    case GDK_VISUAL_STATIC_COLOR: return intern ("static-color");
+    case GDK_VISUAL_PSEUDO_COLOR: return intern ("pseudo-color");
+    case GDK_VISUAL_TRUE_COLOR:   return intern ("true-color");
+    case GDK_VISUAL_DIRECT_COLOR: return intern ("direct-color");
+    default:
+      error ("display has an unknown visual class");
+      return Qnil;     /* suppress compiler warning */
+    }
+}
+
+DEFUN ("gtk-display-visual-depth", Fgtk_display_visual_depth, 0, 1, 0, /*
+Return the bitplane depth of the visual the GTK display DEVICE is using.
+*/
+       (device))
+{
+   return make_int (DEVICE_GTK_DEPTH (decode_gtk_device (device)));
+}
+
+static Lisp_Object
+gtk_device_system_metrics (struct device *d,
+                          enum device_metrics m)
+{
+#if 0
+  GtkStyle *style = gtk_widget_get_style (GTK_WIDGET (DEVICE_GTK_APP_SHELL (d)));
+
+  style = gtk_style_attach (style, w);
+#endif
+  
+  switch (m)
+    {
+    case DM_size_device:
+      return Fcons (make_int (gdk_screen_width ()),
+                   make_int (gdk_screen_height ()));
+    case DM_size_device_mm:
+      return Fcons (make_int (gdk_screen_width_mm ()),
+                   make_int (gdk_screen_height_mm ()));
+    case DM_num_color_cells:
+      return make_int (gdk_colormap_get_system_size ());
+    case DM_num_bit_planes:
+      return make_int (DEVICE_GTK_DEPTH (d));
+
+#if 0
+    case DM_color_default:
+    case DM_color_select:
+    case DM_color_balloon:
+    case DM_color_3d_face:
+    case DM_color_3d_light:
+    case DM_color_3d_dark:
+    case DM_color_menu:
+    case DM_color_menu_highlight:
+    case DM_color_menu_button:
+    case DM_color_menu_disabled:
+    case DM_color_toolbar:
+    case DM_color_scrollbar:
+    case DM_color_desktop:
+    case DM_color_workspace:
+    case DM_font_default:
+    case DM_font_menubar:
+    case DM_font_dialog:
+    case DM_size_cursor:
+    case DM_size_scrollbar:
+    case DM_size_menu:
+    case DM_size_toolbar:
+    case DM_size_toolbar_button:
+    case DM_size_toolbar_border:
+    case DM_size_icon:
+    case DM_size_icon_small:
+    case DM_size_workspace:
+    case DM_device_dpi:
+    case DM_mouse_buttons:
+    case DM_swap_buttons:
+    case DM_show_sounds:
+    case DM_slow_device:
+    case DM_security:
+#endif
+    default: /* No such device metric property for GTK devices  */
+      return Qunbound;
+    }
+}
+
+DEFUN ("gtk-keysym-on-keyboard-p", Fgtk_keysym_on_keyboard_p, 1, 2, 0, /*
+Return true if KEYSYM names a key on the keyboard of DEVICE.
+More precisely, return true if some keystroke (possibly including modifiers)
+on the keyboard of DEVICE keys generates KEYSYM.
+Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in
+/usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system.
+The keysym name can be provided in two forms:
+- if keysym is a string, it must be the name as known to X windows.
+- if keysym is a symbol, it must be the name as known to XEmacs.
+The two names differ in capitalization and underscoring.
+*/
+       (keysym, device))
+{
+  struct device *d = decode_device (device);
+
+  if (!DEVICE_GTK_P (d))
+    signal_simple_error ("Not a GTK device", device);
+
+  return (NILP (Fgethash (keysym, DEVICE_GTK_DATA (d)->x_keysym_map_hashtable, Qnil)) ?
+         Qnil : Qt);
+}
+
+\f
+/************************************************************************/
+/*                          grabs and ungrabs                           */
+/************************************************************************/
+
+DEFUN ("gtk-grab-pointer", Fgtk_grab_pointer, 0, 3, 0, /*
+Grab the pointer and restrict it to its current window.
+If optional DEVICE argument is nil, the default device will be used.
+If optional CURSOR argument is non-nil, change the pointer shape to that
+ until `gtk-ungrab-pointer' is called (it should be an object returned by the
+ `make-cursor-glyph' function).
+If the second optional argument IGNORE-KEYBOARD is non-nil, ignore all
+  keyboard events during the grab.
+Returns t if the grab is successful, nil otherwise.
+*/
+       (device, cursor, ignore_keyboard))
+{
+  GdkWindow *w;
+  int result;
+  struct device *d = decode_gtk_device (device);
+
+  if (!NILP (cursor))
+    {
+      CHECK_POINTER_GLYPH (cursor);
+      cursor = glyph_image_instance (cursor, device, ERROR_ME, 0);
+    }
+
+  /* We should call gdk_pointer_grab() and (possibly) gdk_keyboard_grab() here instead */
+  w = GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (device_selected_frame (d)));
+
+  result = gdk_pointer_grab (w, FALSE,
+                            GDK_POINTER_MOTION_MASK |
+                            GDK_POINTER_MOTION_HINT_MASK |
+                            GDK_BUTTON1_MOTION_MASK |
+                            GDK_BUTTON2_MOTION_MASK |
+                            GDK_BUTTON3_MOTION_MASK |
+                            GDK_BUTTON_PRESS_MASK |
+                            GDK_BUTTON_RELEASE_MASK,
+                            w,
+                            NULL, /* #### BILL!!! Need to create a GdkCursor * as necessary! */
+                            GDK_CURRENT_TIME);
+
+  return (result == 0) ? Qt : Qnil;
+}
+
+DEFUN ("gtk-ungrab-pointer", Fgtk_ungrab_pointer, 0, 1, 0, /*
+Release a pointer grab made with `gtk-grab-pointer'.
+If optional first arg DEVICE is nil the default device is used.
+If it is t the pointer will be released on all GTK devices.
+*/
+       (device))
+{
+  if (!EQ (device, Qt))
+    {
+       gdk_pointer_ungrab (GDK_CURRENT_TIME);
+    }
+  else
+    {
+      Lisp_Object devcons, concons;
+
+      DEVICE_LOOP_NO_BREAK (devcons, concons)
+       {
+         struct device *d = XDEVICE (XCAR (devcons));
+
+         if (DEVICE_GTK_P (d))
+             gdk_pointer_ungrab (GDK_CURRENT_TIME);
+       }
+    }
+  return Qnil;
+}
+
+DEFUN ("gtk-grab-keyboard", Fgtk_grab_keyboard, 0, 1, 0, /*
+Grab the keyboard on the given device (defaulting to the selected one).
+So long as the keyboard is grabbed, all keyboard events will be delivered
+to emacs -- it is not possible for other clients to eavesdrop on them.
+Ungrab the keyboard with `gtk-ungrab-keyboard' (use an unwind-protect).
+Returns t if the grab is successful, nil otherwise.
+*/
+       (device))
+{
+  struct device *d = decode_gtk_device (device);
+  GdkWindow *w = GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (device_selected_frame (d)));
+
+  gdk_keyboard_grab (w, FALSE, GDK_CURRENT_TIME );
+
+  return Qt;
+}
+
+DEFUN ("gtk-ungrab-keyboard", Fgtk_ungrab_keyboard, 0, 1, 0, /*
+Release a keyboard grab made with `gtk-grab-keyboard'.
+*/
+       (device))
+{
+  gdk_keyboard_ungrab (GDK_CURRENT_TIME);
+  return Qnil;
+}
+
+\f
+/************************************************************************/
+/*                              Style Info                              */
+/************************************************************************/
+DEFUN ("gtk-style-info", Fgtk_style_info, 0, 1, 0, /*
+Get the style information for a Gtk device.
+*/
+       (device))
+{
+  struct device *d = decode_device (device);
+  GtkStyle *style = NULL;
+  Lisp_Object result = Qnil;
+  GtkWidget *app_shell = GTK_WIDGET (DEVICE_GTK_APP_SHELL (d));
+  GdkWindow *w = GET_GTK_WIDGET_WINDOW (app_shell);
+
+  if (!DEVICE_GTK_P (d))
+    return (Qnil);
+
+  style = gtk_widget_get_style (app_shell);
+  style = gtk_style_attach (style, w);
+
+  if (!style) return (Qnil);
+
+#define FROB_COLOR(slot, name) \
+ result = nconc2 (result, \
+               list2 (intern (name), \
+               list5 (xemacs_gtk_convert_color (&style->slot[GTK_STATE_NORMAL], app_shell),\
+                       xemacs_gtk_convert_color (&style->slot[GTK_STATE_ACTIVE], app_shell),\
+                       xemacs_gtk_convert_color (&style->slot[GTK_STATE_PRELIGHT], app_shell),\
+                       xemacs_gtk_convert_color (&style->slot[GTK_STATE_SELECTED], app_shell),\
+                       xemacs_gtk_convert_color (&style->slot[GTK_STATE_INSENSITIVE], app_shell))))
+
+  FROB_COLOR (fg, "foreground");
+  FROB_COLOR (bg, "background");
+  FROB_COLOR (light, "light");
+  FROB_COLOR (dark, "dark");
+  FROB_COLOR (mid, "mid");
+  FROB_COLOR (text, "text");
+  FROB_COLOR (base, "base");
+#undef FROB_COLOR
+
+  result = nconc2 (result, list2 (Qfont, convert_font (style->font)));
+
+#define FROB_PIXMAP(state) (style->rc_style->bg_pixmap_name[state] ? build_string (style->rc_style->bg_pixmap_name[state]) : Qnil)
+
+  if (style->rc_style)
+    result = nconc2 (result, list2 (Qbackground,
+                                   list5 ( FROB_PIXMAP (GTK_STATE_NORMAL),
+                                           FROB_PIXMAP (GTK_STATE_ACTIVE),
+                                           FROB_PIXMAP (GTK_STATE_PRELIGHT),
+                                           FROB_PIXMAP (GTK_STATE_SELECTED),
+                                           FROB_PIXMAP (GTK_STATE_INSENSITIVE))));
+#undef FROB_PIXMAP
+
+  return (result);
+}
+
+static unsigned int
+gtk_device_implementation_flags (void)
+{
+  return 0; /* XDEVIMPF_PIXEL_GEOMETRY; */
+}
+
+\f
+/************************************************************************/
+/*                            initialization                            */
+/************************************************************************/
+
+void
+syms_of_device_gtk (void)
+{
+  DEFSUBR (Fdefault_gtk_device);
+  DEFSUBR (Fgtk_keysym_on_keyboard_p);
+  DEFSUBR (Fgtk_display_visual_class);
+  DEFSUBR (Fgtk_display_visual_depth);
+  DEFSUBR (Fgtk_style_info);
+  DEFSUBR (Fgtk_grab_pointer);
+  DEFSUBR (Fgtk_ungrab_pointer);
+  DEFSUBR (Fgtk_grab_keyboard);
+  DEFSUBR (Fgtk_ungrab_keyboard);
+  DEFSUBR (Fgtk_init);
+
+  defsymbol (&Qinit_pre_gtk_win, "init-pre-gtk-win");
+  defsymbol (&Qinit_post_gtk_win, "init-post-gtk-win");
+}
+
+void
+console_type_create_device_gtk (void)
+{
+  CONSOLE_HAS_METHOD (gtk, init_device);
+  CONSOLE_HAS_METHOD (gtk, finish_init_device);
+  CONSOLE_HAS_METHOD (gtk, mark_device);
+  CONSOLE_HAS_METHOD (gtk, delete_device);
+  CONSOLE_HAS_METHOD (gtk, device_system_metrics);
+  CONSOLE_HAS_METHOD (gtk, device_implementation_flags);
+}
+
+void
+vars_of_device_gtk (void)
+{
+  Fprovide (Qgtk);
+
+  staticpro (&Vdefault_gtk_device);
+
+  DEFVAR_LISP ("gtk-initial-argv-list", &Vgtk_initial_argv_list /*
+You don't want to know.
+This is used during startup to communicate the remaining arguments in
+`command-line-args-left' to the C code, which passes the args to
+the GTK initialization code, which removes some args, and then the
+args are placed back into `gtk-initial-arg-list' and thence into
+`command-line-args-left'.  Perhaps `command-line-args-left' should
+just reside in C.
+*/ );
+
+  DEFVAR_LISP ("gtk-initial-geometry", &Vgtk_initial_geometry /*
+You don't want to know.
+This is used during startup to communicate the default geometry to GTK.
+*/ );
+
+  Vdefault_gtk_device = Qnil;
+  Vgtk_initial_geometry = Qnil;
+  Vgtk_initial_argv_list = Qnil;
+}
+
+#include <gdk/gdkx.h>
+static void
+gtk_device_init_x_specific_cruft (struct device *d)
+{
+  DEVICE_INFD (d) = DEVICE_OUTFD (d) = ConnectionNumber (GDK_DISPLAY ());
+}

diff --git a/src/dialog-gtk.c b/src/dialog-gtk.c
new file mode 100644 (file)
index 0000000..048d186
--- /dev/null
+++ b/src/dialog-gtk.c
@@ -0,0 +1,63 @@
+/* Implements elisp-programmable dialog boxes -- Gtk interface.
+   Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+   Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
+
+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, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with: Not in FSF. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "console-gtk.h"
+#include "gui-gtk.h"
+
+#include "buffer.h"
+#include "commands.h"           /* zmacs_regions */
+#include "events.h"
+#include "frame.h"
+#include "gui.h"
+#include "opaque.h"
+#include "window.h"
+
+Lisp_Object Qgtk_make_dialog_box_internal;
+
+/* We just bounce up into lisp here... see $(srcdir)/lisp/dialog-gtk.el */
+static Lisp_Object
+gtk_make_dialog_box_internal (struct frame* f, Lisp_Object type, Lisp_Object keys)
+{
+  return (call2 (Qgtk_make_dialog_box_internal, type, keys));
+}
+
+void
+syms_of_dialog_gtk (void)
+{
+  defsymbol (&Qgtk_make_dialog_box_internal, "gtk-make-dialog-box-internal");
+}
+
+void
+console_type_create_dialog_gtk (void)
+{
+  CONSOLE_HAS_METHOD (gtk, make_dialog_box_internal);
+}
+
+void
+vars_of_dialog_gtk (void)
+{
+  Fprovide (intern ("gtk-dialogs"));
+}

diff --git a/src/emacs-marshals.c b/src/emacs-marshals.c
new file mode 100644 (file)
index 0000000..3ddc7a4
--- /dev/null
+++ b/src/emacs-marshals.c
@@ -0,0 +1,1597 @@
+#define GTK_VALUE_ARRAY(x) GTK_VALUE_POINTER(x)
+
+#define GTK_VALUE_LIST(x) GTK_VALUE_POINTER(x)
+
+
+static void
+emacs_gtk_marshal_BOOL__OBJECT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __BOOL_fn rfunc = (__BOOL_fn) func;
+  gboolean *return_val;
+
+  return_val = GTK_RETLOC_BOOL (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]));
+}
+
+static void
+emacs_gtk_marshal_BOOL__OBJECT_OBJECT_OBJECT (ffi_actual_function func, GtkArg *args)
+{
+  __BOOL_fn rfunc = (__BOOL_fn) func;
+  gboolean *return_val;
+
+  return_val = GTK_RETLOC_BOOL (args[3]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_OBJECT (args[1]), GTK_VALUE_OBJECT (args[2]));
+}
+
+static void
+emacs_gtk_marshal_BOOL__OBJECT_OBJECT (ffi_actual_function func, GtkArg *args)
+{
+  __BOOL_fn rfunc = (__BOOL_fn) func;
+  gboolean *return_val;
+
+  return_val = GTK_RETLOC_BOOL (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_OBJECT (args[1]));
+}
+
+static void
+emacs_gtk_marshal_BOOL__OBJECT_POINTER (ffi_actual_function func, GtkArg *args)
+{
+  __BOOL_fn rfunc = (__BOOL_fn) func;
+  gboolean *return_val;
+
+  return_val = GTK_RETLOC_BOOL (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_POINTER (args[1]));
+}
+
+static void
+emacs_gtk_marshal_BOOL__OBJECT_STRING (ffi_actual_function func, GtkArg *args)
+{
+  __BOOL_fn rfunc = (__BOOL_fn) func;
+  gboolean *return_val;
+
+  return_val = GTK_RETLOC_BOOL (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_STRING (args[1]));
+}
+
+static void
+emacs_gtk_marshal_BOOL__OBJECT (ffi_actual_function func, GtkArg *args)
+{
+  __BOOL_fn rfunc = (__BOOL_fn) func;
+  gboolean *return_val;
+
+  return_val = GTK_RETLOC_BOOL (args[1]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]));
+}
+
+static void
+emacs_gtk_marshal_BOOL__POINTER_BOOL (ffi_actual_function func, GtkArg *args)
+{
+  __BOOL_fn rfunc = (__BOOL_fn) func;
+  gboolean *return_val;
+
+  return_val = GTK_RETLOC_BOOL (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_POINTER (args[0]), GTK_VALUE_BOOL (args[1]));
+}
+
+static void
+emacs_gtk_marshal_BOOL__POINTER (ffi_actual_function func, GtkArg *args)
+{
+  __BOOL_fn rfunc = (__BOOL_fn) func;
+  gboolean *return_val;
+
+  return_val = GTK_RETLOC_BOOL (args[1]);
+  *return_val = (*rfunc) (GTK_VALUE_POINTER (args[0]));
+}
+
+static void
+emacs_gtk_marshal_BOOL__NONE (ffi_actual_function func, GtkArg *args)
+{
+  __BOOL_fn rfunc = (__BOOL_fn) func;
+  gboolean *return_val;
+
+  return_val = GTK_RETLOC_BOOL (args[0]);
+  *return_val = (*rfunc) ();
+}
+typedef gfloat (*__FLOAT__OBJECT_FLOAT_fn)(GtkObject *, gfloat);
+
+static void
+emacs_gtk_marshal_FLOAT__OBJECT_FLOAT (ffi_actual_function func, GtkArg *args)
+{
+  __FLOAT__OBJECT_FLOAT_fn rfunc = (__FLOAT__OBJECT_FLOAT_fn) func;
+  gfloat *return_val;
+
+  return_val = GTK_RETLOC_FLOAT (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_FLOAT (args[1]));
+}
+
+static void
+emacs_gtk_marshal_FLOAT__OBJECT (ffi_actual_function func, GtkArg *args)
+{
+  __FLOAT_fn rfunc = (__FLOAT_fn) func;
+  gfloat *return_val;
+
+  return_val = GTK_RETLOC_FLOAT (args[1]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]));
+}
+
+static void
+emacs_gtk_marshal_INT__BOOL (ffi_actual_function func, GtkArg *args)
+{
+  __INT_fn rfunc = (__INT_fn) func;
+  guint *return_val;
+
+  return_val = GTK_RETLOC_INT (args[1]);
+  *return_val = (*rfunc) (GTK_VALUE_BOOL (args[0]));
+}
+
+static void
+emacs_gtk_marshal_INT__OBJECT_ARRAY (ffi_actual_function func, GtkArg *args)
+{
+  __INT_fn rfunc = (__INT_fn) func;
+  guint *return_val;
+
+  return_val = GTK_RETLOC_INT (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_ARRAY (args[1]));
+}
+
+static void
+emacs_gtk_marshal_INT__OBJECT_INT_ARRAY (ffi_actual_function func, GtkArg *args)
+{
+  __INT_fn rfunc = (__INT_fn) func;
+  guint *return_val;
+
+  return_val = GTK_RETLOC_INT (args[3]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_ARRAY (args[2]));
+}
+
+static void
+emacs_gtk_marshal_INT__OBJECT_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __INT_fn rfunc = (__INT_fn) func;
+  guint *return_val;
+
+  return_val = GTK_RETLOC_INT (args[3]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_INT (args[2]));
+}
+
+static void
+emacs_gtk_marshal_INT__OBJECT_INT_STRING (ffi_actual_function func, GtkArg *args)
+{
+  __INT_fn rfunc = (__INT_fn) func;
+  guint *return_val;
+
+  return_val = GTK_RETLOC_INT (args[3]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_STRING (args[2]));
+}
+
+static void
+emacs_gtk_marshal_INT__OBJECT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __INT_fn rfunc = (__INT_fn) func;
+  guint *return_val;
+
+  return_val = GTK_RETLOC_INT (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]));
+}
+
+static void
+emacs_gtk_marshal_INT__OBJECT_OBJECT (ffi_actual_function func, GtkArg *args)
+{
+  __INT_fn rfunc = (__INT_fn) func;
+  guint *return_val;
+
+  return_val = GTK_RETLOC_INT (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_OBJECT (args[1]));
+}
+
+static void
+emacs_gtk_marshal_INT__OBJECT_POINTER_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __INT_fn rfunc = (__INT_fn) func;
+  guint *return_val;
+
+  return_val = GTK_RETLOC_INT (args[4]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_POINTER (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_INT (args[3]));
+}
+
+static void
+emacs_gtk_marshal_INT__OBJECT_POINTER_INT (ffi_actual_function func, GtkArg *args)
+{
+  __INT_fn rfunc = (__INT_fn) func;
+  guint *return_val;
+
+  return_val = GTK_RETLOC_INT (args[3]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_POINTER (args[1]), GTK_VALUE_INT (args[2]));
+}
+
+static void
+emacs_gtk_marshal_INT__OBJECT_POINTER (ffi_actual_function func, GtkArg *args)
+{
+  __INT_fn rfunc = (__INT_fn) func;
+  guint *return_val;
+
+  return_val = GTK_RETLOC_INT (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_POINTER (args[1]));
+}
+
+static void
+emacs_gtk_marshal_INT__OBJECT_STRING (ffi_actual_function func, GtkArg *args)
+{
+  __INT_fn rfunc = (__INT_fn) func;
+  guint *return_val;
+
+  return_val = GTK_RETLOC_INT (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_STRING (args[1]));
+}
+
+static void
+emacs_gtk_marshal_INT__OBJECT (ffi_actual_function func, GtkArg *args)
+{
+  __INT_fn rfunc = (__INT_fn) func;
+  guint *return_val;
+
+  return_val = GTK_RETLOC_INT (args[1]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]));
+}
+
+static void
+emacs_gtk_marshal_INT__POINTER (ffi_actual_function func, GtkArg *args)
+{
+  __INT_fn rfunc = (__INT_fn) func;
+  guint *return_val;
+
+  return_val = GTK_RETLOC_INT (args[1]);
+  *return_val = (*rfunc) (GTK_VALUE_POINTER (args[0]));
+}
+
+static void
+emacs_gtk_marshal_INT__STRING_STRING_INT_ARRAY (ffi_actual_function func, GtkArg *args)
+{
+  __INT_fn rfunc = (__INT_fn) func;
+  guint *return_val;
+
+  return_val = GTK_RETLOC_INT (args[4]);
+  *return_val = (*rfunc) (GTK_VALUE_STRING (args[0]), GTK_VALUE_STRING (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_ARRAY (args[3]));
+}
+
+static void
+emacs_gtk_marshal_INT__STRING (ffi_actual_function func, GtkArg *args)
+{
+  __INT_fn rfunc = (__INT_fn) func;
+  guint *return_val;
+
+  return_val = GTK_RETLOC_INT (args[1]);
+  *return_val = (*rfunc) (GTK_VALUE_STRING (args[0]));
+}
+
+static void
+emacs_gtk_marshal_INT__NONE (ffi_actual_function func, GtkArg *args)
+{
+  __INT_fn rfunc = (__INT_fn) func;
+  guint *return_val;
+
+  return_val = GTK_RETLOC_INT (args[0]);
+  *return_val = (*rfunc) ();
+}
+
+static void
+emacs_gtk_marshal_LIST__OBJECT (ffi_actual_function func, GtkArg *args)
+{
+  __LIST_fn rfunc = (__LIST_fn) func;
+  void * *return_val;
+
+  return_val = GTK_RETLOC_POINTER (args[1]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]));
+}
+
+static void
+emacs_gtk_marshal_LIST__NONE (ffi_actual_function func, GtkArg *args)
+{
+  __LIST_fn rfunc = (__LIST_fn) func;
+  void * *return_val;
+
+  return_val = GTK_RETLOC_POINTER (args[0]);
+  *return_val = (*rfunc) ();
+}
+
+static void
+emacs_gtk_marshal_NONE__BOOL (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_BOOL (args[0]));
+}
+
+static void
+emacs_gtk_marshal_NONE__INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_INT (args[0]), GTK_VALUE_INT (args[1]));
+}
+
+static void
+emacs_gtk_marshal_NONE__INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_INT (args[0]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_BOOL_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_BOOL (args[1]), GTK_VALUE_INT (args[2]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_BOOL (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_BOOL (args[1]));
+}
+typedef void (*__NONE__OBJECT_FLOAT_FLOAT_FLOAT_BOOL_fn)(GtkObject *, gfloat, gfloat, gfloat, gboolean);
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_FLOAT_FLOAT_FLOAT_BOOL (ffi_actual_function func, GtkArg *args)
+{
+  __NONE__OBJECT_FLOAT_FLOAT_FLOAT_BOOL_fn rfunc = (__NONE__OBJECT_FLOAT_FLOAT_FLOAT_BOOL_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_FLOAT (args[1]), GTK_VALUE_FLOAT (args[2]), GTK_VALUE_FLOAT (args[3]), GTK_VALUE_BOOL (args[4]));
+}
+typedef void (*__NONE__OBJECT_FLOAT_FLOAT_FLOAT_FLOAT_fn)(GtkObject *, gfloat, gfloat, gfloat, gfloat);
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_FLOAT_FLOAT_FLOAT_FLOAT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE__OBJECT_FLOAT_FLOAT_FLOAT_FLOAT_fn rfunc = (__NONE__OBJECT_FLOAT_FLOAT_FLOAT_FLOAT_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_FLOAT (args[1]), GTK_VALUE_FLOAT (args[2]), GTK_VALUE_FLOAT (args[3]), GTK_VALUE_FLOAT (args[4]));
+}
+typedef void (*__NONE__OBJECT_FLOAT_FLOAT_FLOAT_fn)(GtkObject *, gfloat, gfloat, gfloat);
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_FLOAT_FLOAT_FLOAT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE__OBJECT_FLOAT_FLOAT_FLOAT_fn rfunc = (__NONE__OBJECT_FLOAT_FLOAT_FLOAT_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_FLOAT (args[1]), GTK_VALUE_FLOAT (args[2]), GTK_VALUE_FLOAT (args[3]));
+}
+typedef void (*__NONE__OBJECT_FLOAT_FLOAT_fn)(GtkObject *, gfloat, gfloat);
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_FLOAT_FLOAT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE__OBJECT_FLOAT_FLOAT_fn rfunc = (__NONE__OBJECT_FLOAT_FLOAT_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_FLOAT (args[1]), GTK_VALUE_FLOAT (args[2]));
+}
+typedef void (*__NONE__OBJECT_FLOAT_fn)(GtkObject *, gfloat);
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_FLOAT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE__OBJECT_FLOAT_fn rfunc = (__NONE__OBJECT_FLOAT_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_FLOAT (args[1]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_INT_BOOL (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_BOOL (args[2]));
+}
+typedef void (*__NONE__OBJECT_INT_FLOAT_BOOL_fn)(GtkObject *, guint, gfloat, gboolean);
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_INT_FLOAT_BOOL (ffi_actual_function func, GtkArg *args)
+{
+  __NONE__OBJECT_INT_FLOAT_BOOL_fn rfunc = (__NONE__OBJECT_INT_FLOAT_BOOL_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_FLOAT (args[2]), GTK_VALUE_BOOL (args[3]));
+}
+typedef void (*__NONE__OBJECT_INT_FLOAT_fn)(GtkObject *, guint, gfloat);
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_INT_FLOAT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE__OBJECT_INT_FLOAT_fn rfunc = (__NONE__OBJECT_INT_FLOAT_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_FLOAT (args[2]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_INT_INT_ARRAY_ARRAY_ARRAY_ARRAY_ARRAY_ARRAY (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_ARRAY (args[3]), GTK_VALUE_ARRAY (args[4]), GTK_VALUE_ARRAY (args[5]), GTK_VALUE_ARRAY (args[6]), GTK_VALUE_ARRAY (args[7]), GTK_VALUE_ARRAY (args[8]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_INT_INT_ARRAY (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_ARRAY (args[3]));
+}
+typedef void (*__NONE__OBJECT_INT_INT_FLOAT_FLOAT_fn)(GtkObject *, guint, guint, gfloat, gfloat);
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_INT_INT_FLOAT_FLOAT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE__OBJECT_INT_INT_FLOAT_FLOAT_fn rfunc = (__NONE__OBJECT_INT_INT_FLOAT_FLOAT_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_FLOAT (args[3]), GTK_VALUE_FLOAT (args[4]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_INT_INT_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_INT (args[3]), GTK_VALUE_INT (args[4]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_INT_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_INT (args[3]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_INT_INT_POINTER_POINTER (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_POINTER (args[3]), GTK_VALUE_POINTER (args[4]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_INT_INT_POINTER (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_POINTER (args[3]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_INT_INT_STRING_INT_POINTER_POINTER (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_STRING (args[3]), GTK_VALUE_INT (args[4]), GTK_VALUE_POINTER (args[5]), GTK_VALUE_POINTER (args[6]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_INT_INT_STRING (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_STRING (args[3]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_INT (args[2]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_INT_OBJECT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_OBJECT (args[2]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_INT_POINTER (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_POINTER (args[2]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_INT_STRING (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_STRING (args[2]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_LIST_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_LIST (args[1]), GTK_VALUE_INT (args[2]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_LIST (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_LIST (args[1]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_OBJECT_BOOL_BOOL_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_OBJECT (args[1]), GTK_VALUE_BOOL (args[2]), GTK_VALUE_BOOL (args[3]), GTK_VALUE_INT (args[4]), GTK_VALUE_INT (args[5]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_OBJECT_BOOL_BOOL_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_OBJECT (args[1]), GTK_VALUE_BOOL (args[2]), GTK_VALUE_BOOL (args[3]), GTK_VALUE_INT (args[4]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_OBJECT_BOOL_BOOL (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_OBJECT (args[1]), GTK_VALUE_BOOL (args[2]), GTK_VALUE_BOOL (args[3]));
+}
+typedef void (*__NONE__OBJECT_OBJECT_FLOAT_INT_fn)(GtkObject *, GtkObject *, gfloat, guint);
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_OBJECT_FLOAT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE__OBJECT_OBJECT_FLOAT_INT_fn rfunc = (__NONE__OBJECT_OBJECT_FLOAT_INT_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_OBJECT (args[1]), GTK_VALUE_FLOAT (args[2]), GTK_VALUE_INT (args[3]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_OBJECT_INT_INT_INT_INT_INT_INT_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_OBJECT (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_INT (args[3]), GTK_VALUE_INT (args[4]), GTK_VALUE_INT (args[5]), GTK_VALUE_INT (args[6]), GTK_VALUE_INT (args[7]), GTK_VALUE_INT (args[8]), GTK_VALUE_INT (args[9]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_OBJECT_INT_INT_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_OBJECT (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_INT (args[3]), GTK_VALUE_INT (args[4]), GTK_VALUE_INT (args[5]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_OBJECT_INT_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_OBJECT (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_INT (args[3]), GTK_VALUE_INT (args[4]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_OBJECT_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_OBJECT (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_INT (args[3]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_OBJECT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_OBJECT (args[1]), GTK_VALUE_INT (args[2]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_OBJECT_OBJECT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_OBJECT (args[1]), GTK_VALUE_OBJECT (args[2]), GTK_VALUE_INT (args[3]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_OBJECT_OBJECT_OBJECT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_OBJECT (args[1]), GTK_VALUE_OBJECT (args[2]), GTK_VALUE_OBJECT (args[3]), GTK_VALUE_INT (args[4]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_OBJECT_OBJECT_OBJECT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_OBJECT (args[1]), GTK_VALUE_OBJECT (args[2]), GTK_VALUE_OBJECT (args[3]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_OBJECT_OBJECT_POINTER_POINTER_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_OBJECT (args[1]), GTK_VALUE_OBJECT (args[2]), GTK_VALUE_POINTER (args[3]), GTK_VALUE_POINTER (args[4]), GTK_VALUE_INT (args[5]), GTK_VALUE_INT (args[6]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_OBJECT_OBJECT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_OBJECT (args[1]), GTK_VALUE_OBJECT (args[2]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_OBJECT_POINTER (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_OBJECT (args[1]), GTK_VALUE_POINTER (args[2]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_OBJECT_STRING_INT_INT_INT_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_OBJECT (args[1]), GTK_VALUE_STRING (args[2]), GTK_VALUE_INT (args[3]), GTK_VALUE_INT (args[4]), GTK_VALUE_INT (args[5]), GTK_VALUE_INT (args[6]), GTK_VALUE_INT (args[7]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_OBJECT_STRING_STRING_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_OBJECT (args[1]), GTK_VALUE_STRING (args[2]), GTK_VALUE_STRING (args[3]), GTK_VALUE_INT (args[4]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_OBJECT_STRING_STRING (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_OBJECT (args[1]), GTK_VALUE_STRING (args[2]), GTK_VALUE_STRING (args[3]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_OBJECT_STRING (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_OBJECT (args[1]), GTK_VALUE_STRING (args[2]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_OBJECT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_OBJECT (args[1]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_POINTER_BOOL (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_POINTER (args[1]), GTK_VALUE_BOOL (args[2]));
+}
+typedef void (*__NONE__OBJECT_POINTER_INT_FLOAT_FLOAT_fn)(GtkObject *, void *, guint, gfloat, gfloat);
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_POINTER_INT_FLOAT_FLOAT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE__OBJECT_POINTER_INT_FLOAT_FLOAT_fn rfunc = (__NONE__OBJECT_POINTER_INT_FLOAT_FLOAT_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_POINTER (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_FLOAT (args[3]), GTK_VALUE_FLOAT (args[4]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_POINTER_INT_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_POINTER (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_INT (args[3]), GTK_VALUE_INT (args[4]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_POINTER_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_POINTER (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_INT (args[3]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_POINTER_INT_POINTER_POINTER (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_POINTER (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_POINTER (args[3]), GTK_VALUE_POINTER (args[4]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_POINTER_INT_POINTER (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_POINTER (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_POINTER (args[3]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_POINTER_INT_STRING_INT_POINTER_POINTER (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_POINTER (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_STRING (args[3]), GTK_VALUE_INT (args[4]), GTK_VALUE_POINTER (args[5]), GTK_VALUE_POINTER (args[6]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_POINTER_INT_STRING (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_POINTER (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_STRING (args[3]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_POINTER_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_POINTER (args[1]), GTK_VALUE_INT (args[2]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_POINTER_POINTER_POINTER_STRING_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_POINTER (args[1]), GTK_VALUE_POINTER (args[2]), GTK_VALUE_POINTER (args[3]), GTK_VALUE_STRING (args[4]), GTK_VALUE_INT (args[5]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_POINTER_POINTER_POINTER (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_POINTER (args[1]), GTK_VALUE_POINTER (args[2]), GTK_VALUE_POINTER (args[3]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_POINTER_POINTER (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_POINTER (args[1]), GTK_VALUE_POINTER (args[2]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_POINTER_STRING_INT_POINTER_POINTER_POINTER_POINTER_BOOL_BOOL (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_POINTER (args[1]), GTK_VALUE_STRING (args[2]), GTK_VALUE_INT (args[3]), GTK_VALUE_POINTER (args[4]), GTK_VALUE_POINTER (args[5]), GTK_VALUE_POINTER (args[6]), GTK_VALUE_POINTER (args[7]), GTK_VALUE_BOOL (args[8]), GTK_VALUE_BOOL (args[9]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_POINTER (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_POINTER (args[1]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_STRING_BOOL (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_STRING (args[1]), GTK_VALUE_BOOL (args[2]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_STRING_POINTER_INT_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_STRING (args[1]), GTK_VALUE_POINTER (args[2]), GTK_VALUE_INT (args[3]), GTK_VALUE_INT (args[4]), GTK_VALUE_INT (args[5]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_STRING_POINTER_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_STRING (args[1]), GTK_VALUE_POINTER (args[2]), GTK_VALUE_INT (args[3]), GTK_VALUE_INT (args[4]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_STRING_STRING (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_STRING (args[1]), GTK_VALUE_STRING (args[2]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_STRING (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_STRING (args[1]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]));
+}
+
+static void
+emacs_gtk_marshal_NONE__POINTER_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_POINTER (args[0]), GTK_VALUE_INT (args[1]));
+}
+
+static void
+emacs_gtk_marshal_NONE__POINTER_POINTER_BOOL_INT_INT_INT_INT_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_POINTER (args[0]), GTK_VALUE_POINTER (args[1]), GTK_VALUE_BOOL (args[2]), GTK_VALUE_INT (args[3]), GTK_VALUE_INT (args[4]), GTK_VALUE_INT (args[5]), GTK_VALUE_INT (args[6]), GTK_VALUE_INT (args[7]), GTK_VALUE_INT (args[8]));
+}
+
+static void
+emacs_gtk_marshal_NONE__POINTER_POINTER_BOOL_INT_INT_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_POINTER (args[0]), GTK_VALUE_POINTER (args[1]), GTK_VALUE_BOOL (args[2]), GTK_VALUE_INT (args[3]), GTK_VALUE_INT (args[4]), GTK_VALUE_INT (args[5]), GTK_VALUE_INT (args[6]));
+}
+
+static void
+emacs_gtk_marshal_NONE__POINTER_POINTER_INT_INT_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_POINTER (args[0]), GTK_VALUE_POINTER (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_INT (args[3]), GTK_VALUE_INT (args[4]), GTK_VALUE_INT (args[5]));
+}
+
+static void
+emacs_gtk_marshal_NONE__POINTER_POINTER_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_POINTER (args[0]), GTK_VALUE_POINTER (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_INT (args[3]));
+}
+
+static void
+emacs_gtk_marshal_NONE__POINTER_POINTER_POINTER_INT_INT_STRING_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_POINTER (args[0]), GTK_VALUE_POINTER (args[1]), GTK_VALUE_POINTER (args[2]), GTK_VALUE_INT (args[3]), GTK_VALUE_INT (args[4]), GTK_VALUE_STRING (args[5]), GTK_VALUE_INT (args[6]));
+}
+
+static void
+emacs_gtk_marshal_NONE__POINTER_POINTER_POINTER_INT_INT_STRING (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_POINTER (args[0]), GTK_VALUE_POINTER (args[1]), GTK_VALUE_POINTER (args[2]), GTK_VALUE_INT (args[3]), GTK_VALUE_INT (args[4]), GTK_VALUE_STRING (args[5]));
+}
+
+static void
+emacs_gtk_marshal_NONE__POINTER_POINTER_POINTER_POINTER (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_POINTER (args[0]), GTK_VALUE_POINTER (args[1]), GTK_VALUE_POINTER (args[2]), GTK_VALUE_POINTER (args[3]));
+}
+
+static void
+emacs_gtk_marshal_NONE__POINTER_POINTER (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_POINTER (args[0]), GTK_VALUE_POINTER (args[1]));
+}
+
+static void
+emacs_gtk_marshal_NONE__POINTER_STRING (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_POINTER (args[0]), GTK_VALUE_STRING (args[1]));
+}
+
+static void
+emacs_gtk_marshal_NONE__POINTER (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_POINTER (args[0]));
+}
+
+static void
+emacs_gtk_marshal_NONE__NONE (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) ();
+}
+
+static void
+emacs_gtk_marshal_OBJECT__BOOL_BOOL_INT (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT_fn rfunc = (__OBJECT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[3]);
+  *return_val = (*rfunc) (GTK_VALUE_BOOL (args[0]), GTK_VALUE_BOOL (args[1]), GTK_VALUE_INT (args[2]));
+}
+
+static void
+emacs_gtk_marshal_OBJECT__BOOL_INT (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT_fn rfunc = (__OBJECT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_BOOL (args[0]), GTK_VALUE_INT (args[1]));
+}
+typedef GtkObject * (*__OBJECT__FLOAT_FLOAT_FLOAT_FLOAT_FLOAT_FLOAT_fn)(gfloat, gfloat, gfloat, gfloat, gfloat, gfloat);
+
+static void
+emacs_gtk_marshal_OBJECT__FLOAT_FLOAT_FLOAT_FLOAT_FLOAT_FLOAT (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT__FLOAT_FLOAT_FLOAT_FLOAT_FLOAT_FLOAT_fn rfunc = (__OBJECT__FLOAT_FLOAT_FLOAT_FLOAT_FLOAT_FLOAT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[6]);
+  *return_val = (*rfunc) (GTK_VALUE_FLOAT (args[0]), GTK_VALUE_FLOAT (args[1]), GTK_VALUE_FLOAT (args[2]), GTK_VALUE_FLOAT (args[3]), GTK_VALUE_FLOAT (args[4]), GTK_VALUE_FLOAT (args[5]));
+}
+typedef GtkObject * (*__OBJECT__FLOAT_FLOAT_FLOAT_FLOAT_FLOAT_fn)(gfloat, gfloat, gfloat, gfloat, gfloat);
+
+static void
+emacs_gtk_marshal_OBJECT__FLOAT_FLOAT_FLOAT_FLOAT_FLOAT (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT__FLOAT_FLOAT_FLOAT_FLOAT_FLOAT_fn rfunc = (__OBJECT__FLOAT_FLOAT_FLOAT_FLOAT_FLOAT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[5]);
+  *return_val = (*rfunc) (GTK_VALUE_FLOAT (args[0]), GTK_VALUE_FLOAT (args[1]), GTK_VALUE_FLOAT (args[2]), GTK_VALUE_FLOAT (args[3]), GTK_VALUE_FLOAT (args[4]));
+}
+typedef GtkObject * (*__OBJECT__FLOAT_FLOAT_FLOAT_FLOAT_fn)(gfloat, gfloat, gfloat, gfloat);
+
+static void
+emacs_gtk_marshal_OBJECT__FLOAT_FLOAT_FLOAT_FLOAT (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT__FLOAT_FLOAT_FLOAT_FLOAT_fn rfunc = (__OBJECT__FLOAT_FLOAT_FLOAT_FLOAT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[4]);
+  *return_val = (*rfunc) (GTK_VALUE_FLOAT (args[0]), GTK_VALUE_FLOAT (args[1]), GTK_VALUE_FLOAT (args[2]), GTK_VALUE_FLOAT (args[3]));
+}
+
+static void
+emacs_gtk_marshal_OBJECT__INT_ARRAY (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT_fn rfunc = (__OBJECT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_INT (args[0]), GTK_VALUE_ARRAY (args[1]));
+}
+
+static void
+emacs_gtk_marshal_OBJECT__INT_BOOL_BOOL (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT_fn rfunc = (__OBJECT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[3]);
+  *return_val = (*rfunc) (GTK_VALUE_INT (args[0]), GTK_VALUE_BOOL (args[1]), GTK_VALUE_BOOL (args[2]));
+}
+
+static void
+emacs_gtk_marshal_OBJECT__INT_INT_ARRAY (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT_fn rfunc = (__OBJECT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[3]);
+  *return_val = (*rfunc) (GTK_VALUE_INT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_ARRAY (args[2]));
+}
+
+static void
+emacs_gtk_marshal_OBJECT__INT_INT_BOOL (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT_fn rfunc = (__OBJECT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[3]);
+  *return_val = (*rfunc) (GTK_VALUE_INT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_BOOL (args[2]));
+}
+
+static void
+emacs_gtk_marshal_OBJECT__INT_INT_STRING (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT_fn rfunc = (__OBJECT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[3]);
+  *return_val = (*rfunc) (GTK_VALUE_INT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_STRING (args[2]));
+}
+
+static void
+emacs_gtk_marshal_OBJECT__INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT_fn rfunc = (__OBJECT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_INT (args[0]), GTK_VALUE_INT (args[1]));
+}
+
+static void
+emacs_gtk_marshal_OBJECT__INT (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT_fn rfunc = (__OBJECT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[1]);
+  *return_val = (*rfunc) (GTK_VALUE_INT (args[0]));
+}
+typedef GtkObject * (*__OBJECT__OBJECT_FLOAT_INT_fn)(GtkObject *, gfloat, guint);
+
+static void
+emacs_gtk_marshal_OBJECT__OBJECT_FLOAT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT__OBJECT_FLOAT_INT_fn rfunc = (__OBJECT__OBJECT_FLOAT_INT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[3]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_FLOAT (args[1]), GTK_VALUE_INT (args[2]));
+}
+
+static void
+emacs_gtk_marshal_OBJECT__OBJECT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT_fn rfunc = (__OBJECT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]));
+}
+
+static void
+emacs_gtk_marshal_OBJECT__OBJECT_OBJECT (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT_fn rfunc = (__OBJECT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_OBJECT (args[1]));
+}
+
+static void
+emacs_gtk_marshal_OBJECT__OBJECT_STRING_INT_INT_INT_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT_fn rfunc = (__OBJECT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[7]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_STRING (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_INT (args[3]), GTK_VALUE_INT (args[4]), GTK_VALUE_INT (args[5]), GTK_VALUE_INT (args[6]));
+}
+
+static void
+emacs_gtk_marshal_OBJECT__OBJECT_STRING_INT_INT_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT_fn rfunc = (__OBJECT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[6]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_STRING (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_INT (args[3]), GTK_VALUE_INT (args[4]), GTK_VALUE_INT (args[5]));
+}
+
+static void
+emacs_gtk_marshal_OBJECT__OBJECT_STRING_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT_fn rfunc = (__OBJECT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[4]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_STRING (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_INT (args[3]));
+}
+
+static void
+emacs_gtk_marshal_OBJECT__OBJECT_STRING (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT_fn rfunc = (__OBJECT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_STRING (args[1]));
+}
+
+static void
+emacs_gtk_marshal_OBJECT__OBJECT (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT_fn rfunc = (__OBJECT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[1]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]));
+}
+
+static void
+emacs_gtk_marshal_OBJECT__POINTER_POINTER (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT_fn rfunc = (__OBJECT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_POINTER (args[0]), GTK_VALUE_POINTER (args[1]));
+}
+
+static void
+emacs_gtk_marshal_OBJECT__POINTER_STRING (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT_fn rfunc = (__OBJECT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_POINTER (args[0]), GTK_VALUE_STRING (args[1]));
+}
+
+static void
+emacs_gtk_marshal_OBJECT__POINTER (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT_fn rfunc = (__OBJECT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[1]);
+  *return_val = (*rfunc) (GTK_VALUE_POINTER (args[0]));
+}
+typedef GtkObject * (*__OBJECT__STRING_FLOAT_FLOAT_FLOAT_BOOL_fn)(gchar *, gfloat, gfloat, gfloat, gboolean);
+
+static void
+emacs_gtk_marshal_OBJECT__STRING_FLOAT_FLOAT_FLOAT_BOOL (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT__STRING_FLOAT_FLOAT_FLOAT_BOOL_fn rfunc = (__OBJECT__STRING_FLOAT_FLOAT_FLOAT_BOOL_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[5]);
+  *return_val = (*rfunc) (GTK_VALUE_STRING (args[0]), GTK_VALUE_FLOAT (args[1]), GTK_VALUE_FLOAT (args[2]), GTK_VALUE_FLOAT (args[3]), GTK_VALUE_BOOL (args[4]));
+}
+
+static void
+emacs_gtk_marshal_OBJECT__STRING_INT_STRING_STRING (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT_fn rfunc = (__OBJECT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[4]);
+  *return_val = (*rfunc) (GTK_VALUE_STRING (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_STRING (args[2]), GTK_VALUE_STRING (args[3]));
+}
+
+static void
+emacs_gtk_marshal_OBJECT__STRING_OBJECT (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT_fn rfunc = (__OBJECT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_STRING (args[0]), GTK_VALUE_OBJECT (args[1]));
+}
+
+static void
+emacs_gtk_marshal_OBJECT__STRING_STRING_STRING_ARRAY_STRING_STRING (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT_fn rfunc = (__OBJECT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[6]);
+  *return_val = (*rfunc) (GTK_VALUE_STRING (args[0]), GTK_VALUE_STRING (args[1]), GTK_VALUE_STRING (args[2]), GTK_VALUE_ARRAY (args[3]), GTK_VALUE_STRING (args[4]), GTK_VALUE_STRING (args[5]));
+}
+
+static void
+emacs_gtk_marshal_OBJECT__STRING_STRING (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT_fn rfunc = (__OBJECT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_STRING (args[0]), GTK_VALUE_STRING (args[1]));
+}
+
+static void
+emacs_gtk_marshal_OBJECT__STRING (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT_fn rfunc = (__OBJECT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[1]);
+  *return_val = (*rfunc) (GTK_VALUE_STRING (args[0]));
+}
+
+static void
+emacs_gtk_marshal_OBJECT__NONE (ffi_actual_function func, GtkArg *args)
+{
+  __OBJECT_fn rfunc = (__OBJECT_fn) func;
+  GtkObject * *return_val;
+
+  return_val = GTK_RETLOC_OBJECT (args[0]);
+  *return_val = (*rfunc) ();
+}
+
+static void
+emacs_gtk_marshal_POINTER__INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __POINTER_fn rfunc = (__POINTER_fn) func;
+  void * *return_val;
+
+  return_val = GTK_RETLOC_POINTER (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_INT (args[0]), GTK_VALUE_INT (args[1]));
+}
+
+static void
+emacs_gtk_marshal_POINTER__INT (ffi_actual_function func, GtkArg *args)
+{
+  __POINTER_fn rfunc = (__POINTER_fn) func;
+  void * *return_val;
+
+  return_val = GTK_RETLOC_POINTER (args[1]);
+  *return_val = (*rfunc) (GTK_VALUE_INT (args[0]));
+}
+
+static void
+emacs_gtk_marshal_POINTER__OBJECT_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __POINTER_fn rfunc = (__POINTER_fn) func;
+  void * *return_val;
+
+  return_val = GTK_RETLOC_POINTER (args[3]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_INT (args[2]));
+}
+
+static void
+emacs_gtk_marshal_POINTER__OBJECT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __POINTER_fn rfunc = (__POINTER_fn) func;
+  void * *return_val;
+
+  return_val = GTK_RETLOC_POINTER (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]));
+}
+
+static void
+emacs_gtk_marshal_POINTER__OBJECT_POINTER_INT (ffi_actual_function func, GtkArg *args)
+{
+  __POINTER_fn rfunc = (__POINTER_fn) func;
+  void * *return_val;
+
+  return_val = GTK_RETLOC_POINTER (args[3]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_POINTER (args[1]), GTK_VALUE_INT (args[2]));
+}
+
+static void
+emacs_gtk_marshal_POINTER__OBJECT_POINTER_POINTER_ARRAY_INT_POINTER_POINTER_POINTER_POINTER_BOOL_BOOL (ffi_actual_function func, GtkArg *args)
+{
+  __POINTER_fn rfunc = (__POINTER_fn) func;
+  void * *return_val;
+
+  return_val = GTK_RETLOC_POINTER (args[11]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_POINTER (args[1]), GTK_VALUE_POINTER (args[2]), GTK_VALUE_ARRAY (args[3]), GTK_VALUE_INT (args[4]), GTK_VALUE_POINTER (args[5]), GTK_VALUE_POINTER (args[6]), GTK_VALUE_POINTER (args[7]), GTK_VALUE_POINTER (args[8]), GTK_VALUE_BOOL (args[9]), GTK_VALUE_BOOL (args[10]));
+}
+
+static void
+emacs_gtk_marshal_POINTER__OBJECT_POINTER (ffi_actual_function func, GtkArg *args)
+{
+  __POINTER_fn rfunc = (__POINTER_fn) func;
+  void * *return_val;
+
+  return_val = GTK_RETLOC_POINTER (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_POINTER (args[1]));
+}
+
+static void
+emacs_gtk_marshal_POINTER__OBJECT (ffi_actual_function func, GtkArg *args)
+{
+  __POINTER_fn rfunc = (__POINTER_fn) func;
+  void * *return_val;
+
+  return_val = GTK_RETLOC_POINTER (args[1]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]));
+}
+
+static void
+emacs_gtk_marshal_POINTER__POINTER (ffi_actual_function func, GtkArg *args)
+{
+  __POINTER_fn rfunc = (__POINTER_fn) func;
+  void * *return_val;
+
+  return_val = GTK_RETLOC_POINTER (args[1]);
+  *return_val = (*rfunc) (GTK_VALUE_POINTER (args[0]));
+}
+
+static void
+emacs_gtk_marshal_POINTER__NONE (ffi_actual_function func, GtkArg *args)
+{
+  __POINTER_fn rfunc = (__POINTER_fn) func;
+  void * *return_val;
+
+  return_val = GTK_RETLOC_POINTER (args[0]);
+  *return_val = (*rfunc) ();
+}
+
+static void
+emacs_gtk_marshal_STRING__INT_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __STRING_fn rfunc = (__STRING_fn) func;
+  gchar * *return_val;
+
+  return_val = GTK_RETLOC_STRING (args[3]);
+  *return_val = (*rfunc) (GTK_VALUE_INT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_INT (args[2]));
+}
+
+static void
+emacs_gtk_marshal_STRING__INT (ffi_actual_function func, GtkArg *args)
+{
+  __STRING_fn rfunc = (__STRING_fn) func;
+  gchar * *return_val;
+
+  return_val = GTK_RETLOC_STRING (args[1]);
+  *return_val = (*rfunc) (GTK_VALUE_INT (args[0]));
+}
+
+static void
+emacs_gtk_marshal_STRING__OBJECT_BOOL (ffi_actual_function func, GtkArg *args)
+{
+  __STRING_fn rfunc = (__STRING_fn) func;
+  gchar * *return_val;
+
+  return_val = GTK_RETLOC_STRING (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_BOOL (args[1]));
+}
+typedef gchar * (*__STRING__OBJECT_FLOAT_fn)(GtkObject *, gfloat);
+
+static void
+emacs_gtk_marshal_STRING__OBJECT_FLOAT (ffi_actual_function func, GtkArg *args)
+{
+  __STRING__OBJECT_FLOAT_fn rfunc = (__STRING__OBJECT_FLOAT_fn) func;
+  gchar * *return_val;
+
+  return_val = GTK_RETLOC_STRING (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_FLOAT (args[1]));
+}
+
+static void
+emacs_gtk_marshal_STRING__OBJECT_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __STRING_fn rfunc = (__STRING_fn) func;
+  gchar * *return_val;
+
+  return_val = GTK_RETLOC_STRING (args[3]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_INT (args[2]));
+}
+
+static void
+emacs_gtk_marshal_STRING__OBJECT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __STRING_fn rfunc = (__STRING_fn) func;
+  gchar * *return_val;
+
+  return_val = GTK_RETLOC_STRING (args[2]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_INT (args[1]));
+}
+
+static void
+emacs_gtk_marshal_STRING__OBJECT (ffi_actual_function func, GtkArg *args)
+{
+  __STRING_fn rfunc = (__STRING_fn) func;
+  gchar * *return_val;
+
+  return_val = GTK_RETLOC_STRING (args[1]);
+  *return_val = (*rfunc) (GTK_VALUE_OBJECT (args[0]));
+}
+
+static void
+emacs_gtk_marshal_STRING__NONE (ffi_actual_function func, GtkArg *args)
+{
+  __STRING_fn rfunc = (__STRING_fn) func;
+  gchar * *return_val;
+
+  return_val = GTK_RETLOC_STRING (args[0]);
+  *return_val = (*rfunc) ();
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_POINTER_POINTER_INT_INT_INT_INT_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_POINTER (args[1]), GTK_VALUE_POINTER (args[2]), GTK_VALUE_INT (args[3]), GTK_VALUE_INT (args[4]), GTK_VALUE_INT (args[5]), GTK_VALUE_INT (args[6]), GTK_VALUE_INT (args[7]), GTK_VALUE_INT (args[8]));
+}
+
+static void
+emacs_gtk_marshal_NONE__OBJECT_STRING_INT_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_OBJECT (args[0]), GTK_VALUE_STRING (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_INT (args[3]), GTK_VALUE_INT (args[4]));
+}
+
+static void
+emacs_gtk_marshal_NONE__INT_INT_INT_INT (ffi_actual_function func, GtkArg *args)
+{
+  __NONE_fn rfunc = (__NONE_fn) func;
+  (*rfunc) (GTK_VALUE_INT (args[0]), GTK_VALUE_INT (args[1]), GTK_VALUE_INT (args[2]), GTK_VALUE_INT (args[3]));
+}
+
+\f
+#include "hash.h"
+static struct hash_table * marshaller_hashtable;
+
+extern unsigned long string_hash (const char *xv);
+
+static int
+our_string_eq (const void *st1, const void *st2)
+{
+  if (!st1)
+    return st2 ? 0 : 1;
+  else if (!st2)
+    return 0;
+  else
+    return !strcmp ( (const char *) st1, (const char *) st2);
+}
+
+unsigned long
+our_string_hash (const void *xv)
+{
+  unsigned int h = 0;
+  unsigned const char *x = (unsigned const char *) xv;
+
+  if (!x) return 0;
+
+  while (*x)
+    {
+      unsigned int g;
+      h = (h << 4) + *x++;
+      if ((g = h & 0xf0000000) != 0)
+       h = (h ^ (g >> 24)) ^ g;
+    }
+
+  return h;
+}
+
+static void initialize_marshaller_storage (void)
+{
+       if (!marshaller_hashtable)
+       {
+               marshaller_hashtable = make_general_hash_table (100, our_string_hash, our_string_eq);
+               puthash ("emacs_gtk_marshal_BOOL__OBJECT_INT", (void *) emacs_gtk_marshal_BOOL__OBJECT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_BOOL__OBJECT_OBJECT_OBJECT", (void *) emacs_gtk_marshal_BOOL__OBJECT_OBJECT_OBJECT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_BOOL__OBJECT_OBJECT", (void *) emacs_gtk_marshal_BOOL__OBJECT_OBJECT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_BOOL__OBJECT_POINTER", (void *) emacs_gtk_marshal_BOOL__OBJECT_POINTER, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_BOOL__OBJECT_STRING", (void *) emacs_gtk_marshal_BOOL__OBJECT_STRING, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_BOOL__OBJECT", (void *) emacs_gtk_marshal_BOOL__OBJECT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_BOOL__POINTER_BOOL", (void *) emacs_gtk_marshal_BOOL__POINTER_BOOL, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_BOOL__POINTER", (void *) emacs_gtk_marshal_BOOL__POINTER, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_BOOL__NONE", (void *) emacs_gtk_marshal_BOOL__NONE, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_FLOAT__OBJECT_FLOAT", (void *) emacs_gtk_marshal_FLOAT__OBJECT_FLOAT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_FLOAT__OBJECT", (void *) emacs_gtk_marshal_FLOAT__OBJECT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_INT__BOOL", (void *) emacs_gtk_marshal_INT__BOOL, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_INT__OBJECT_ARRAY", (void *) emacs_gtk_marshal_INT__OBJECT_ARRAY, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_INT__OBJECT_INT_ARRAY", (void *) emacs_gtk_marshal_INT__OBJECT_INT_ARRAY, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_INT__OBJECT_INT_INT", (void *) emacs_gtk_marshal_INT__OBJECT_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_INT__OBJECT_INT_STRING", (void *) emacs_gtk_marshal_INT__OBJECT_INT_STRING, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_INT__OBJECT_INT", (void *) emacs_gtk_marshal_INT__OBJECT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_INT__OBJECT_OBJECT", (void *) emacs_gtk_marshal_INT__OBJECT_OBJECT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_INT__OBJECT_POINTER_INT_INT", (void *) emacs_gtk_marshal_INT__OBJECT_POINTER_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_INT__OBJECT_POINTER_INT", (void *) emacs_gtk_marshal_INT__OBJECT_POINTER_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_INT__OBJECT_POINTER", (void *) emacs_gtk_marshal_INT__OBJECT_POINTER, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_INT__OBJECT_STRING", (void *) emacs_gtk_marshal_INT__OBJECT_STRING, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_INT__OBJECT", (void *) emacs_gtk_marshal_INT__OBJECT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_INT__POINTER", (void *) emacs_gtk_marshal_INT__POINTER, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_INT__STRING_STRING_INT_ARRAY", (void *) emacs_gtk_marshal_INT__STRING_STRING_INT_ARRAY, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_INT__STRING", (void *) emacs_gtk_marshal_INT__STRING, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_INT__NONE", (void *) emacs_gtk_marshal_INT__NONE, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_LIST__OBJECT", (void *) emacs_gtk_marshal_LIST__OBJECT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_LIST__NONE", (void *) emacs_gtk_marshal_LIST__NONE, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__BOOL", (void *) emacs_gtk_marshal_NONE__BOOL, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__INT_INT", (void *) emacs_gtk_marshal_NONE__INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__INT", (void *) emacs_gtk_marshal_NONE__INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_BOOL_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_BOOL_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_BOOL", (void *) emacs_gtk_marshal_NONE__OBJECT_BOOL, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_FLOAT_FLOAT_FLOAT_BOOL", (void *) emacs_gtk_marshal_NONE__OBJECT_FLOAT_FLOAT_FLOAT_BOOL, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_FLOAT_FLOAT_FLOAT_FLOAT", (void *) emacs_gtk_marshal_NONE__OBJECT_FLOAT_FLOAT_FLOAT_FLOAT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_FLOAT_FLOAT_FLOAT", (void *) emacs_gtk_marshal_NONE__OBJECT_FLOAT_FLOAT_FLOAT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_FLOAT_FLOAT", (void *) emacs_gtk_marshal_NONE__OBJECT_FLOAT_FLOAT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_FLOAT", (void *) emacs_gtk_marshal_NONE__OBJECT_FLOAT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_INT_BOOL", (void *) emacs_gtk_marshal_NONE__OBJECT_INT_BOOL, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_INT_FLOAT_BOOL", (void *) emacs_gtk_marshal_NONE__OBJECT_INT_FLOAT_BOOL, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_INT_FLOAT", (void *) emacs_gtk_marshal_NONE__OBJECT_INT_FLOAT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_INT_INT_ARRAY_ARRAY_ARRAY_ARRAY_ARRAY_ARRAY", (void *) emacs_gtk_marshal_NONE__OBJECT_INT_INT_ARRAY_ARRAY_ARRAY_ARRAY_ARRAY_ARRAY, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_INT_INT_ARRAY", (void *) emacs_gtk_marshal_NONE__OBJECT_INT_INT_ARRAY, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_INT_INT_FLOAT_FLOAT", (void *) emacs_gtk_marshal_NONE__OBJECT_INT_INT_FLOAT_FLOAT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_INT_INT_INT_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_INT_INT_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_INT_INT_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_INT_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_INT_INT_POINTER_POINTER", (void *) emacs_gtk_marshal_NONE__OBJECT_INT_INT_POINTER_POINTER, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_INT_INT_POINTER", (void *) emacs_gtk_marshal_NONE__OBJECT_INT_INT_POINTER, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_INT_INT_STRING_INT_POINTER_POINTER", (void *) emacs_gtk_marshal_NONE__OBJECT_INT_INT_STRING_INT_POINTER_POINTER, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_INT_INT_STRING", (void *) emacs_gtk_marshal_NONE__OBJECT_INT_INT_STRING, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_INT_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_INT_OBJECT", (void *) emacs_gtk_marshal_NONE__OBJECT_INT_OBJECT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_INT_POINTER", (void *) emacs_gtk_marshal_NONE__OBJECT_INT_POINTER, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_INT_STRING", (void *) emacs_gtk_marshal_NONE__OBJECT_INT_STRING, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_LIST_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_LIST_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_LIST", (void *) emacs_gtk_marshal_NONE__OBJECT_LIST, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_OBJECT_BOOL_BOOL_INT_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_OBJECT_BOOL_BOOL_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_OBJECT_BOOL_BOOL_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_OBJECT_BOOL_BOOL_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_OBJECT_BOOL_BOOL", (void *) emacs_gtk_marshal_NONE__OBJECT_OBJECT_BOOL_BOOL, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_OBJECT_FLOAT_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_OBJECT_FLOAT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_OBJECT_INT_INT_INT_INT_INT_INT_INT_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_OBJECT_INT_INT_INT_INT_INT_INT_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_OBJECT_INT_INT_INT_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_OBJECT_INT_INT_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_OBJECT_INT_INT_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_OBJECT_INT_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_OBJECT_INT_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_OBJECT_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_OBJECT_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_OBJECT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_OBJECT_OBJECT_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_OBJECT_OBJECT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_OBJECT_OBJECT_OBJECT_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_OBJECT_OBJECT_OBJECT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_OBJECT_OBJECT_OBJECT", (void *) emacs_gtk_marshal_NONE__OBJECT_OBJECT_OBJECT_OBJECT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_OBJECT_OBJECT_POINTER_POINTER_INT_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_OBJECT_OBJECT_POINTER_POINTER_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_OBJECT_OBJECT", (void *) emacs_gtk_marshal_NONE__OBJECT_OBJECT_OBJECT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_OBJECT_POINTER", (void *) emacs_gtk_marshal_NONE__OBJECT_OBJECT_POINTER, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_OBJECT_STRING_INT_INT_INT_INT_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_OBJECT_STRING_INT_INT_INT_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_OBJECT_STRING_STRING_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_OBJECT_STRING_STRING_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_OBJECT_STRING_STRING", (void *) emacs_gtk_marshal_NONE__OBJECT_OBJECT_STRING_STRING, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_OBJECT_STRING", (void *) emacs_gtk_marshal_NONE__OBJECT_OBJECT_STRING, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_OBJECT", (void *) emacs_gtk_marshal_NONE__OBJECT_OBJECT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_POINTER_BOOL", (void *) emacs_gtk_marshal_NONE__OBJECT_POINTER_BOOL, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_POINTER_INT_FLOAT_FLOAT", (void *) emacs_gtk_marshal_NONE__OBJECT_POINTER_INT_FLOAT_FLOAT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_POINTER_INT_INT_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_POINTER_INT_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_POINTER_INT_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_POINTER_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_POINTER_INT_POINTER_POINTER", (void *) emacs_gtk_marshal_NONE__OBJECT_POINTER_INT_POINTER_POINTER, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_POINTER_INT_POINTER", (void *) emacs_gtk_marshal_NONE__OBJECT_POINTER_INT_POINTER, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_POINTER_INT_STRING_INT_POINTER_POINTER", (void *) emacs_gtk_marshal_NONE__OBJECT_POINTER_INT_STRING_INT_POINTER_POINTER, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_POINTER_INT_STRING", (void *) emacs_gtk_marshal_NONE__OBJECT_POINTER_INT_STRING, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_POINTER_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_POINTER_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_POINTER_POINTER_POINTER_STRING_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_POINTER_POINTER_POINTER_STRING_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_POINTER_POINTER_POINTER", (void *) emacs_gtk_marshal_NONE__OBJECT_POINTER_POINTER_POINTER, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_POINTER_POINTER", (void *) emacs_gtk_marshal_NONE__OBJECT_POINTER_POINTER, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_POINTER_STRING_INT_POINTER_POINTER_POINTER_POINTER_BOOL_BOOL", (void *) emacs_gtk_marshal_NONE__OBJECT_POINTER_STRING_INT_POINTER_POINTER_POINTER_POINTER_BOOL_BOOL, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_POINTER", (void *) emacs_gtk_marshal_NONE__OBJECT_POINTER, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_STRING_BOOL", (void *) emacs_gtk_marshal_NONE__OBJECT_STRING_BOOL, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_STRING_POINTER_INT_INT_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_STRING_POINTER_INT_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_STRING_POINTER_INT_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_STRING_POINTER_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_STRING_STRING", (void *) emacs_gtk_marshal_NONE__OBJECT_STRING_STRING, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_STRING", (void *) emacs_gtk_marshal_NONE__OBJECT_STRING, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT", (void *) emacs_gtk_marshal_NONE__OBJECT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__POINTER_INT", (void *) emacs_gtk_marshal_NONE__POINTER_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__POINTER_POINTER_BOOL_INT_INT_INT_INT_INT_INT", (void *) emacs_gtk_marshal_NONE__POINTER_POINTER_BOOL_INT_INT_INT_INT_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__POINTER_POINTER_BOOL_INT_INT_INT_INT", (void *) emacs_gtk_marshal_NONE__POINTER_POINTER_BOOL_INT_INT_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__POINTER_POINTER_INT_INT_INT_INT", (void *) emacs_gtk_marshal_NONE__POINTER_POINTER_INT_INT_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__POINTER_POINTER_INT_INT", (void *) emacs_gtk_marshal_NONE__POINTER_POINTER_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__POINTER_POINTER_POINTER_INT_INT_STRING_INT", (void *) emacs_gtk_marshal_NONE__POINTER_POINTER_POINTER_INT_INT_STRING_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__POINTER_POINTER_POINTER_INT_INT_STRING", (void *) emacs_gtk_marshal_NONE__POINTER_POINTER_POINTER_INT_INT_STRING, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__POINTER_POINTER_POINTER_POINTER", (void *) emacs_gtk_marshal_NONE__POINTER_POINTER_POINTER_POINTER, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__POINTER_POINTER", (void *) emacs_gtk_marshal_NONE__POINTER_POINTER, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__POINTER_STRING", (void *) emacs_gtk_marshal_NONE__POINTER_STRING, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__POINTER", (void *) emacs_gtk_marshal_NONE__POINTER, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__NONE", (void *) emacs_gtk_marshal_NONE__NONE, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__BOOL_BOOL_INT", (void *) emacs_gtk_marshal_OBJECT__BOOL_BOOL_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__BOOL_INT", (void *) emacs_gtk_marshal_OBJECT__BOOL_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__FLOAT_FLOAT_FLOAT_FLOAT_FLOAT_FLOAT", (void *) emacs_gtk_marshal_OBJECT__FLOAT_FLOAT_FLOAT_FLOAT_FLOAT_FLOAT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__FLOAT_FLOAT_FLOAT_FLOAT_FLOAT", (void *) emacs_gtk_marshal_OBJECT__FLOAT_FLOAT_FLOAT_FLOAT_FLOAT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__FLOAT_FLOAT_FLOAT_FLOAT", (void *) emacs_gtk_marshal_OBJECT__FLOAT_FLOAT_FLOAT_FLOAT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__INT_ARRAY", (void *) emacs_gtk_marshal_OBJECT__INT_ARRAY, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__INT_BOOL_BOOL", (void *) emacs_gtk_marshal_OBJECT__INT_BOOL_BOOL, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__INT_INT_ARRAY", (void *) emacs_gtk_marshal_OBJECT__INT_INT_ARRAY, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__INT_INT_BOOL", (void *) emacs_gtk_marshal_OBJECT__INT_INT_BOOL, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__INT_INT_STRING", (void *) emacs_gtk_marshal_OBJECT__INT_INT_STRING, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__INT_INT", (void *) emacs_gtk_marshal_OBJECT__INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__INT", (void *) emacs_gtk_marshal_OBJECT__INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__OBJECT_FLOAT_INT", (void *) emacs_gtk_marshal_OBJECT__OBJECT_FLOAT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__OBJECT_INT", (void *) emacs_gtk_marshal_OBJECT__OBJECT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__OBJECT_OBJECT", (void *) emacs_gtk_marshal_OBJECT__OBJECT_OBJECT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__OBJECT_STRING_INT_INT_INT_INT_INT", (void *) emacs_gtk_marshal_OBJECT__OBJECT_STRING_INT_INT_INT_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__OBJECT_STRING_INT_INT_INT_INT", (void *) emacs_gtk_marshal_OBJECT__OBJECT_STRING_INT_INT_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__OBJECT_STRING_INT_INT", (void *) emacs_gtk_marshal_OBJECT__OBJECT_STRING_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__OBJECT_STRING", (void *) emacs_gtk_marshal_OBJECT__OBJECT_STRING, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__OBJECT", (void *) emacs_gtk_marshal_OBJECT__OBJECT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__POINTER_POINTER", (void *) emacs_gtk_marshal_OBJECT__POINTER_POINTER, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__POINTER_STRING", (void *) emacs_gtk_marshal_OBJECT__POINTER_STRING, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__POINTER", (void *) emacs_gtk_marshal_OBJECT__POINTER, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__STRING_FLOAT_FLOAT_FLOAT_BOOL", (void *) emacs_gtk_marshal_OBJECT__STRING_FLOAT_FLOAT_FLOAT_BOOL, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__STRING_INT_STRING_STRING", (void *) emacs_gtk_marshal_OBJECT__STRING_INT_STRING_STRING, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__STRING_OBJECT", (void *) emacs_gtk_marshal_OBJECT__STRING_OBJECT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__STRING_STRING_STRING_ARRAY_STRING_STRING", (void *) emacs_gtk_marshal_OBJECT__STRING_STRING_STRING_ARRAY_STRING_STRING, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__STRING_STRING", (void *) emacs_gtk_marshal_OBJECT__STRING_STRING, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__STRING", (void *) emacs_gtk_marshal_OBJECT__STRING, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_OBJECT__NONE", (void *) emacs_gtk_marshal_OBJECT__NONE, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_POINTER__INT_INT", (void *) emacs_gtk_marshal_POINTER__INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_POINTER__INT", (void *) emacs_gtk_marshal_POINTER__INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_POINTER__OBJECT_INT_INT", (void *) emacs_gtk_marshal_POINTER__OBJECT_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_POINTER__OBJECT_INT", (void *) emacs_gtk_marshal_POINTER__OBJECT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_POINTER__OBJECT_POINTER_INT", (void *) emacs_gtk_marshal_POINTER__OBJECT_POINTER_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_POINTER__OBJECT_POINTER_POINTER_ARRAY_INT_POINTER_POINTER_POINTER_POINTER_BOOL_BOOL", (void *) emacs_gtk_marshal_POINTER__OBJECT_POINTER_POINTER_ARRAY_INT_POINTER_POINTER_POINTER_POINTER_BOOL_BOOL, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_POINTER__OBJECT_POINTER", (void *) emacs_gtk_marshal_POINTER__OBJECT_POINTER, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_POINTER__OBJECT", (void *) emacs_gtk_marshal_POINTER__OBJECT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_POINTER__POINTER", (void *) emacs_gtk_marshal_POINTER__POINTER, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_POINTER__NONE", (void *) emacs_gtk_marshal_POINTER__NONE, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_STRING__INT_INT_INT", (void *) emacs_gtk_marshal_STRING__INT_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_STRING__INT", (void *) emacs_gtk_marshal_STRING__INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_STRING__OBJECT_BOOL", (void *) emacs_gtk_marshal_STRING__OBJECT_BOOL, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_STRING__OBJECT_FLOAT", (void *) emacs_gtk_marshal_STRING__OBJECT_FLOAT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_STRING__OBJECT_INT_INT", (void *) emacs_gtk_marshal_STRING__OBJECT_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_STRING__OBJECT_INT", (void *) emacs_gtk_marshal_STRING__OBJECT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_STRING__OBJECT", (void *) emacs_gtk_marshal_STRING__OBJECT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_STRING__NONE", (void *) emacs_gtk_marshal_STRING__NONE, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_POINTER_POINTER_INT_INT_INT_INT_INT_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_POINTER_POINTER_INT_INT_INT_INT_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__OBJECT_STRING_INT_INT_INT", (void *) emacs_gtk_marshal_NONE__OBJECT_STRING_INT_INT_INT, marshaller_hashtable);
+               puthash ("emacs_gtk_marshal_NONE__INT_INT_INT_INT", (void *) emacs_gtk_marshal_NONE__INT_INT_INT_INT, marshaller_hashtable);
+       };
+}
+
+static void *find_marshaller (const char *func_name)
+{
+       void *fn = NULL;
+       initialize_marshaller_storage ();
+
+       if (gethash (func_name, marshaller_hashtable, (const void **)&fn))
+       {
+               return (fn);
+       }
+
+       return (NULL);
+}

diff --git a/src/emacs-widget-accessors.c b/src/emacs-widget-accessors.c
new file mode 100644 (file)
index 0000000..4d16970
--- /dev/null
+++ b/src/emacs-widget-accessors.c
@@ -0,0 +1,1785 @@
+DEFUN ("gtk-adjustment-lower", Fgtk_adjustment_lower, 1, 1, 0, /*
+Access the `lower' slot of OBJ, a GtkAdjustment object.
+*/
+       (obj))
+{
+       GtkAdjustment *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_ADJUSTMENT (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkAdjustment", obj);
+       };
+
+       the_obj = GTK_ADJUSTMENT (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("gfloat");
+       GTK_VALUE_FLOAT (arg) = the_obj->lower;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-adjustment-upper", Fgtk_adjustment_upper, 1, 1, 0, /*
+Access the `upper' slot of OBJ, a GtkAdjustment object.
+*/
+       (obj))
+{
+       GtkAdjustment *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_ADJUSTMENT (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkAdjustment", obj);
+       };
+
+       the_obj = GTK_ADJUSTMENT (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("gfloat");
+       GTK_VALUE_FLOAT (arg) = the_obj->upper;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-adjustment-value", Fgtk_adjustment_value, 1, 1, 0, /*
+Access the `value' slot of OBJ, a GtkAdjustment object.
+*/
+       (obj))
+{
+       GtkAdjustment *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_ADJUSTMENT (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkAdjustment", obj);
+       };
+
+       the_obj = GTK_ADJUSTMENT (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("gfloat");
+       GTK_VALUE_FLOAT (arg) = the_obj->value;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-adjustment-step-increment", Fgtk_adjustment_step_increment, 1, 1, 0, /*
+Access the `step_increment' slot of OBJ, a GtkAdjustment object.
+*/
+       (obj))
+{
+       GtkAdjustment *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_ADJUSTMENT (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkAdjustment", obj);
+       };
+
+       the_obj = GTK_ADJUSTMENT (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("gfloat");
+       GTK_VALUE_FLOAT (arg) = the_obj->step_increment;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-adjustment-page-increment", Fgtk_adjustment_page_increment, 1, 1, 0, /*
+Access the `page_increment' slot of OBJ, a GtkAdjustment object.
+*/
+       (obj))
+{
+       GtkAdjustment *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_ADJUSTMENT (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkAdjustment", obj);
+       };
+
+       the_obj = GTK_ADJUSTMENT (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("gfloat");
+       GTK_VALUE_FLOAT (arg) = the_obj->page_increment;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-adjustment-page-size", Fgtk_adjustment_page_size, 1, 1, 0, /*
+Access the `page_size' slot of OBJ, a GtkAdjustment object.
+*/
+       (obj))
+{
+       GtkAdjustment *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_ADJUSTMENT (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkAdjustment", obj);
+       };
+
+       the_obj = GTK_ADJUSTMENT (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("gfloat");
+       GTK_VALUE_FLOAT (arg) = the_obj->page_size;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-widget-style", Fgtk_widget_style, 1, 1, 0, /*
+Access the `style' slot of OBJ, a GtkWidget object.
+*/
+       (obj))
+{
+       GtkWidget *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_WIDGET (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkWidget", obj);
+       };
+
+       the_obj = GTK_WIDGET (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkStyle");
+       GTK_VALUE_BOXED (arg) = (void *)the_obj->style;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-widget-window", Fgtk_widget_window, 1, 1, 0, /*
+Access the `window' slot of OBJ, a GtkWidget object.
+*/
+       (obj))
+{
+       GtkWidget *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_WIDGET (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkWidget", obj);
+       };
+
+       the_obj = GTK_WIDGET (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GdkWindow");
+       GTK_VALUE_BOXED (arg) = (void *)the_obj->window;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-widget-state", Fgtk_widget_state, 1, 1, 0, /*
+Access the `state' slot of OBJ, a GtkWidget object.
+*/
+       (obj))
+{
+       GtkWidget *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_WIDGET (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkWidget", obj);
+       };
+
+       the_obj = GTK_WIDGET (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkStateType");
+       GTK_VALUE_ENUM (arg) = the_obj->state;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-widget-name", Fgtk_widget_name, 1, 1, 0, /*
+Access the `name' slot of OBJ, a GtkWidget object.
+*/
+       (obj))
+{
+       GtkWidget *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_WIDGET (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkWidget", obj);
+       };
+
+       the_obj = GTK_WIDGET (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkString");
+       GTK_VALUE_STRING (arg) = the_obj->name;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-widget-parent", Fgtk_widget_parent, 1, 1, 0, /*
+Access the `parent' slot of OBJ, a GtkWidget object.
+*/
+       (obj))
+{
+       GtkWidget *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_WIDGET (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkWidget", obj);
+       };
+
+       the_obj = GTK_WIDGET (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->parent);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-button-child", Fgtk_button_child, 1, 1, 0, /*
+Access the `child' slot of OBJ, a GtkButton object.
+*/
+       (obj))
+{
+       GtkButton *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_BUTTON (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkButton", obj);
+       };
+
+       the_obj = GTK_BUTTON (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->child);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-button-in-button", Fgtk_button_in_button, 1, 1, 0, /*
+Access the `in_button' slot of OBJ, a GtkButton object.
+*/
+       (obj))
+{
+       GtkButton *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_BUTTON (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkButton", obj);
+       };
+
+       the_obj = GTK_BUTTON (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("gboolean");
+       GTK_VALUE_BOOL (arg) = the_obj->in_button;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-button-button-down", Fgtk_button_button_down, 1, 1, 0, /*
+Access the `button_down' slot of OBJ, a GtkButton object.
+*/
+       (obj))
+{
+       GtkButton *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_BUTTON (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkButton", obj);
+       };
+
+       the_obj = GTK_BUTTON (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("gboolean");
+       GTK_VALUE_BOOL (arg) = the_obj->button_down;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-combo-entry", Fgtk_combo_entry, 1, 1, 0, /*
+Access the `entry' slot of OBJ, a GtkCombo object.
+*/
+       (obj))
+{
+       GtkCombo *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_COMBO (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkCombo", obj);
+       };
+
+       the_obj = GTK_COMBO (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->entry);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-combo-button", Fgtk_combo_button, 1, 1, 0, /*
+Access the `button' slot of OBJ, a GtkCombo object.
+*/
+       (obj))
+{
+       GtkCombo *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_COMBO (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkCombo", obj);
+       };
+
+       the_obj = GTK_COMBO (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->button);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-combo-popup", Fgtk_combo_popup, 1, 1, 0, /*
+Access the `popup' slot of OBJ, a GtkCombo object.
+*/
+       (obj))
+{
+       GtkCombo *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_COMBO (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkCombo", obj);
+       };
+
+       the_obj = GTK_COMBO (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->popup);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-combo-popwin", Fgtk_combo_popwin, 1, 1, 0, /*
+Access the `popwin' slot of OBJ, a GtkCombo object.
+*/
+       (obj))
+{
+       GtkCombo *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_COMBO (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkCombo", obj);
+       };
+
+       the_obj = GTK_COMBO (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->popwin);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-combo-list", Fgtk_combo_list, 1, 1, 0, /*
+Access the `list' slot of OBJ, a GtkCombo object.
+*/
+       (obj))
+{
+       GtkCombo *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_COMBO (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkCombo", obj);
+       };
+
+       the_obj = GTK_COMBO (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->list);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-gamma-curve-table", Fgtk_gamma_curve_table, 1, 1, 0, /*
+Access the `table' slot of OBJ, a GtkGammaCurve object.
+*/
+       (obj))
+{
+       GtkGammaCurve *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_GAMMA_CURVE (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkGammaCurve", obj);
+       };
+
+       the_obj = GTK_GAMMA_CURVE (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->table);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-gamma-curve-curve", Fgtk_gamma_curve_curve, 1, 1, 0, /*
+Access the `curve' slot of OBJ, a GtkGammaCurve object.
+*/
+       (obj))
+{
+       GtkGammaCurve *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_GAMMA_CURVE (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkGammaCurve", obj);
+       };
+
+       the_obj = GTK_GAMMA_CURVE (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->curve);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-gamma-curve-gamma", Fgtk_gamma_curve_gamma, 1, 1, 0, /*
+Access the `gamma' slot of OBJ, a GtkGammaCurve object.
+*/
+       (obj))
+{
+       GtkGammaCurve *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_GAMMA_CURVE (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkGammaCurve", obj);
+       };
+
+       the_obj = GTK_GAMMA_CURVE (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("gfloat");
+       GTK_VALUE_FLOAT (arg) = the_obj->gamma;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-gamma-curve-gamma-dialog", Fgtk_gamma_curve_gamma_dialog, 1, 1, 0, /*
+Access the `gamma_dialog' slot of OBJ, a GtkGammaCurve object.
+*/
+       (obj))
+{
+       GtkGammaCurve *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_GAMMA_CURVE (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkGammaCurve", obj);
+       };
+
+       the_obj = GTK_GAMMA_CURVE (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->gamma_dialog);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-gamma-curve-gamma-text", Fgtk_gamma_curve_gamma_text, 1, 1, 0, /*
+Access the `gamma_text' slot of OBJ, a GtkGammaCurve object.
+*/
+       (obj))
+{
+       GtkGammaCurve *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_GAMMA_CURVE (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkGammaCurve", obj);
+       };
+
+       the_obj = GTK_GAMMA_CURVE (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->gamma_text);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-check-menu-item-active", Fgtk_check_menu_item_active, 1, 1, 0, /*
+Access the `active' slot of OBJ, a GtkCheckMenuItem object.
+*/
+       (obj))
+{
+       GtkCheckMenuItem *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_CHECK_MENU_ITEM (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkCheckMenuItem", obj);
+       };
+
+       the_obj = GTK_CHECK_MENU_ITEM (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("gboolean");
+       GTK_VALUE_BOOL (arg) = the_obj->active;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-notebook-tab-pos", Fgtk_notebook_tab_pos, 1, 1, 0, /*
+Access the `tab_pos' slot of OBJ, a GtkNotebook object.
+*/
+       (obj))
+{
+       GtkNotebook *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_NOTEBOOK (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkNotebook", obj);
+       };
+
+       the_obj = GTK_NOTEBOOK (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkPositionType");
+       GTK_VALUE_ENUM (arg) = the_obj->tab_pos;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-text-hadj", Fgtk_text_hadj, 1, 1, 0, /*
+Access the `hadj' slot of OBJ, a GtkText object.
+*/
+       (obj))
+{
+       GtkText *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_TEXT (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkText", obj);
+       };
+
+       the_obj = GTK_TEXT (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkAdjustment");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->hadj);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-text-vadj", Fgtk_text_vadj, 1, 1, 0, /*
+Access the `vadj' slot of OBJ, a GtkText object.
+*/
+       (obj))
+{
+       GtkText *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_TEXT (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkText", obj);
+       };
+
+       the_obj = GTK_TEXT (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkAdjustment");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->vadj);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-file-selection-dir-list", Fgtk_file_selection_dir_list, 1, 1, 0, /*
+Access the `dir_list' slot of OBJ, a GtkFileSelection object.
+*/
+       (obj))
+{
+       GtkFileSelection *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_FILE_SELECTION (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkFileSelection", obj);
+       };
+
+       the_obj = GTK_FILE_SELECTION (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->dir_list);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-file-selection-file-list", Fgtk_file_selection_file_list, 1, 1, 0, /*
+Access the `file_list' slot of OBJ, a GtkFileSelection object.
+*/
+       (obj))
+{
+       GtkFileSelection *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_FILE_SELECTION (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkFileSelection", obj);
+       };
+
+       the_obj = GTK_FILE_SELECTION (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->file_list);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-file-selection-selection-entry", Fgtk_file_selection_selection_entry, 1, 1, 0, /*
+Access the `selection_entry' slot of OBJ, a GtkFileSelection object.
+*/
+       (obj))
+{
+       GtkFileSelection *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_FILE_SELECTION (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkFileSelection", obj);
+       };
+
+       the_obj = GTK_FILE_SELECTION (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->selection_entry);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-file-selection-selection-text", Fgtk_file_selection_selection_text, 1, 1, 0, /*
+Access the `selection_text' slot of OBJ, a GtkFileSelection object.
+*/
+       (obj))
+{
+       GtkFileSelection *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_FILE_SELECTION (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkFileSelection", obj);
+       };
+
+       the_obj = GTK_FILE_SELECTION (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->selection_text);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-file-selection-main-vbox", Fgtk_file_selection_main_vbox, 1, 1, 0, /*
+Access the `main_vbox' slot of OBJ, a GtkFileSelection object.
+*/
+       (obj))
+{
+       GtkFileSelection *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_FILE_SELECTION (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkFileSelection", obj);
+       };
+
+       the_obj = GTK_FILE_SELECTION (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->main_vbox);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-file-selection-ok-button", Fgtk_file_selection_ok_button, 1, 1, 0, /*
+Access the `ok_button' slot of OBJ, a GtkFileSelection object.
+*/
+       (obj))
+{
+       GtkFileSelection *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_FILE_SELECTION (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkFileSelection", obj);
+       };
+
+       the_obj = GTK_FILE_SELECTION (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->ok_button);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-file-selection-cancel-button", Fgtk_file_selection_cancel_button, 1, 1, 0, /*
+Access the `cancel_button' slot of OBJ, a GtkFileSelection object.
+*/
+       (obj))
+{
+       GtkFileSelection *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_FILE_SELECTION (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkFileSelection", obj);
+       };
+
+       the_obj = GTK_FILE_SELECTION (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->cancel_button);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-file-selection-help-button", Fgtk_file_selection_help_button, 1, 1, 0, /*
+Access the `help_button' slot of OBJ, a GtkFileSelection object.
+*/
+       (obj))
+{
+       GtkFileSelection *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_FILE_SELECTION (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkFileSelection", obj);
+       };
+
+       the_obj = GTK_FILE_SELECTION (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->help_button);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-file-selection-action-area", Fgtk_file_selection_action_area, 1, 1, 0, /*
+Access the `action_area' slot of OBJ, a GtkFileSelection object.
+*/
+       (obj))
+{
+       GtkFileSelection *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_FILE_SELECTION (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkFileSelection", obj);
+       };
+
+       the_obj = GTK_FILE_SELECTION (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->action_area);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-font-selection-dialog-fontsel", Fgtk_font_selection_dialog_fontsel, 1, 1, 0, /*
+Access the `fontsel' slot of OBJ, a GtkFontSelectionDialog object.
+*/
+       (obj))
+{
+       GtkFontSelectionDialog *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_FONT_SELECTION_DIALOG (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkFontSelectionDialog", obj);
+       };
+
+       the_obj = GTK_FONT_SELECTION_DIALOG (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->fontsel);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-font-selection-dialog-main-vbox", Fgtk_font_selection_dialog_main_vbox, 1, 1, 0, /*
+Access the `main_vbox' slot of OBJ, a GtkFontSelectionDialog object.
+*/
+       (obj))
+{
+       GtkFontSelectionDialog *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_FONT_SELECTION_DIALOG (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkFontSelectionDialog", obj);
+       };
+
+       the_obj = GTK_FONT_SELECTION_DIALOG (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->main_vbox);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-font-selection-dialog-action-area", Fgtk_font_selection_dialog_action_area, 1, 1, 0, /*
+Access the `action_area' slot of OBJ, a GtkFontSelectionDialog object.
+*/
+       (obj))
+{
+       GtkFontSelectionDialog *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_FONT_SELECTION_DIALOG (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkFontSelectionDialog", obj);
+       };
+
+       the_obj = GTK_FONT_SELECTION_DIALOG (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->action_area);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-font-selection-dialog-ok-button", Fgtk_font_selection_dialog_ok_button, 1, 1, 0, /*
+Access the `ok_button' slot of OBJ, a GtkFontSelectionDialog object.
+*/
+       (obj))
+{
+       GtkFontSelectionDialog *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_FONT_SELECTION_DIALOG (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkFontSelectionDialog", obj);
+       };
+
+       the_obj = GTK_FONT_SELECTION_DIALOG (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->ok_button);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-font-selection-dialog-apply-button", Fgtk_font_selection_dialog_apply_button, 1, 1, 0, /*
+Access the `apply_button' slot of OBJ, a GtkFontSelectionDialog object.
+*/
+       (obj))
+{
+       GtkFontSelectionDialog *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_FONT_SELECTION_DIALOG (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkFontSelectionDialog", obj);
+       };
+
+       the_obj = GTK_FONT_SELECTION_DIALOG (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->apply_button);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-font-selection-dialog-cancel-button", Fgtk_font_selection_dialog_cancel_button, 1, 1, 0, /*
+Access the `cancel_button' slot of OBJ, a GtkFontSelectionDialog object.
+*/
+       (obj))
+{
+       GtkFontSelectionDialog *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_FONT_SELECTION_DIALOG (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkFontSelectionDialog", obj);
+       };
+
+       the_obj = GTK_FONT_SELECTION_DIALOG (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->cancel_button);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-color-selection-dialog-colorsel", Fgtk_color_selection_dialog_colorsel, 1, 1, 0, /*
+Access the `colorsel' slot of OBJ, a GtkColorSelectionDialog object.
+*/
+       (obj))
+{
+       GtkColorSelectionDialog *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_COLOR_SELECTION_DIALOG (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkColorSelectionDialog", obj);
+       };
+
+       the_obj = GTK_COLOR_SELECTION_DIALOG (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->colorsel);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-color-selection-dialog-main-vbox", Fgtk_color_selection_dialog_main_vbox, 1, 1, 0, /*
+Access the `main_vbox' slot of OBJ, a GtkColorSelectionDialog object.
+*/
+       (obj))
+{
+       GtkColorSelectionDialog *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_COLOR_SELECTION_DIALOG (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkColorSelectionDialog", obj);
+       };
+
+       the_obj = GTK_COLOR_SELECTION_DIALOG (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->main_vbox);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-color-selection-dialog-ok-button", Fgtk_color_selection_dialog_ok_button, 1, 1, 0, /*
+Access the `ok_button' slot of OBJ, a GtkColorSelectionDialog object.
+*/
+       (obj))
+{
+       GtkColorSelectionDialog *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_COLOR_SELECTION_DIALOG (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkColorSelectionDialog", obj);
+       };
+
+       the_obj = GTK_COLOR_SELECTION_DIALOG (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->ok_button);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-color-selection-dialog-reset-button", Fgtk_color_selection_dialog_reset_button, 1, 1, 0, /*
+Access the `reset_button' slot of OBJ, a GtkColorSelectionDialog object.
+*/
+       (obj))
+{
+       GtkColorSelectionDialog *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_COLOR_SELECTION_DIALOG (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkColorSelectionDialog", obj);
+       };
+
+       the_obj = GTK_COLOR_SELECTION_DIALOG (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->reset_button);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-color-selection-dialog-cancel-button", Fgtk_color_selection_dialog_cancel_button, 1, 1, 0, /*
+Access the `cancel_button' slot of OBJ, a GtkColorSelectionDialog object.
+*/
+       (obj))
+{
+       GtkColorSelectionDialog *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_COLOR_SELECTION_DIALOG (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkColorSelectionDialog", obj);
+       };
+
+       the_obj = GTK_COLOR_SELECTION_DIALOG (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->cancel_button);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-color-selection-dialog-help-button", Fgtk_color_selection_dialog_help_button, 1, 1, 0, /*
+Access the `help_button' slot of OBJ, a GtkColorSelectionDialog object.
+*/
+       (obj))
+{
+       GtkColorSelectionDialog *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_COLOR_SELECTION_DIALOG (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkColorSelectionDialog", obj);
+       };
+
+       the_obj = GTK_COLOR_SELECTION_DIALOG (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->help_button);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-dialog-vbox", Fgtk_dialog_vbox, 1, 1, 0, /*
+Access the `vbox' slot of OBJ, a GtkDialog object.
+*/
+       (obj))
+{
+       GtkDialog *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_DIALOG (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkDialog", obj);
+       };
+
+       the_obj = GTK_DIALOG (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->vbox);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-dialog-action-area", Fgtk_dialog_action_area, 1, 1, 0, /*
+Access the `action_area' slot of OBJ, a GtkDialog object.
+*/
+       (obj))
+{
+       GtkDialog *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_DIALOG (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkDialog", obj);
+       };
+
+       the_obj = GTK_DIALOG (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->action_area);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-input-dialog-close-button", Fgtk_input_dialog_close_button, 1, 1, 0, /*
+Access the `close_button' slot of OBJ, a GtkInputDialog object.
+*/
+       (obj))
+{
+       GtkInputDialog *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_INPUT_DIALOG (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkInputDialog", obj);
+       };
+
+       the_obj = GTK_INPUT_DIALOG (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->close_button);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-input-dialog-save-button", Fgtk_input_dialog_save_button, 1, 1, 0, /*
+Access the `save_button' slot of OBJ, a GtkInputDialog object.
+*/
+       (obj))
+{
+       GtkInputDialog *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_INPUT_DIALOG (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkInputDialog", obj);
+       };
+
+       the_obj = GTK_INPUT_DIALOG (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->save_button);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-plug-socket-window", Fgtk_plug_socket_window, 1, 1, 0, /*
+Access the `socket_window' slot of OBJ, a GtkPlug object.
+*/
+       (obj))
+{
+       GtkPlug *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_PLUG (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkPlug", obj);
+       };
+
+       the_obj = GTK_PLUG (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GdkWindow");
+       GTK_VALUE_BOXED (arg) = (void *)the_obj->socket_window;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-plug-same-app", Fgtk_plug_same_app, 1, 1, 0, /*
+Access the `same_app' slot of OBJ, a GtkPlug object.
+*/
+       (obj))
+{
+       GtkPlug *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_PLUG (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkPlug", obj);
+       };
+
+       the_obj = GTK_PLUG (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("gint");
+       GTK_VALUE_INT (arg) = the_obj->same_app;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-object-flags", Fgtk_object_flags, 1, 1, 0, /*
+Access the `flags' slot of OBJ, a GtkObject object.
+*/
+       (obj))
+{
+       GtkObject *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_OBJECT (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkObject", obj);
+       };
+
+       the_obj = GTK_OBJECT (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("guint");
+       GTK_VALUE_UINT (arg) = the_obj->flags;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-object-ref-count", Fgtk_object_ref_count, 1, 1, 0, /*
+Access the `ref_count' slot of OBJ, a GtkObject object.
+*/
+       (obj))
+{
+       GtkObject *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_OBJECT (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkObject", obj);
+       };
+
+       the_obj = GTK_OBJECT (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("guint");
+       GTK_VALUE_UINT (arg) = the_obj->ref_count;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-paned-child1", Fgtk_paned_child1, 1, 1, 0, /*
+Access the `child1' slot of OBJ, a GtkPaned object.
+*/
+       (obj))
+{
+       GtkPaned *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_PANED (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkPaned", obj);
+       };
+
+       the_obj = GTK_PANED (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->child1);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-paned-child2", Fgtk_paned_child2, 1, 1, 0, /*
+Access the `child2' slot of OBJ, a GtkPaned object.
+*/
+       (obj))
+{
+       GtkPaned *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_PANED (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkPaned", obj);
+       };
+
+       the_obj = GTK_PANED (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->child2);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-paned-child1-resize", Fgtk_paned_child1_resize, 1, 1, 0, /*
+Access the `child1_resize' slot of OBJ, a GtkPaned object.
+*/
+       (obj))
+{
+       GtkPaned *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_PANED (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkPaned", obj);
+       };
+
+       the_obj = GTK_PANED (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("gboolean");
+       GTK_VALUE_BOOL (arg) = the_obj->child1_resize;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-paned-child2-resize", Fgtk_paned_child2_resize, 1, 1, 0, /*
+Access the `child2_resize' slot of OBJ, a GtkPaned object.
+*/
+       (obj))
+{
+       GtkPaned *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_PANED (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkPaned", obj);
+       };
+
+       the_obj = GTK_PANED (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("gboolean");
+       GTK_VALUE_BOOL (arg) = the_obj->child2_resize;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-paned-child1-shrink", Fgtk_paned_child1_shrink, 1, 1, 0, /*
+Access the `child1_shrink' slot of OBJ, a GtkPaned object.
+*/
+       (obj))
+{
+       GtkPaned *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_PANED (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkPaned", obj);
+       };
+
+       the_obj = GTK_PANED (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("gboolean");
+       GTK_VALUE_BOOL (arg) = the_obj->child1_shrink;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-paned-child2-shrink", Fgtk_paned_child2_shrink, 1, 1, 0, /*
+Access the `child2_shrink' slot of OBJ, a GtkPaned object.
+*/
+       (obj))
+{
+       GtkPaned *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_PANED (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkPaned", obj);
+       };
+
+       the_obj = GTK_PANED (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("gboolean");
+       GTK_VALUE_BOOL (arg) = the_obj->child2_shrink;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-clist-rows", Fgtk_clist_rows, 1, 1, 0, /*
+Access the `rows' slot of OBJ, a GtkCList object.
+*/
+       (obj))
+{
+       GtkCList *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_CLIST (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkCList", obj);
+       };
+
+       the_obj = GTK_CLIST (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("gint");
+       GTK_VALUE_INT (arg) = the_obj->rows;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-clist-columns", Fgtk_clist_columns, 1, 1, 0, /*
+Access the `columns' slot of OBJ, a GtkCList object.
+*/
+       (obj))
+{
+       GtkCList *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_CLIST (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkCList", obj);
+       };
+
+       the_obj = GTK_CLIST (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("gint");
+       GTK_VALUE_INT (arg) = the_obj->columns;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-clist-hadjustment", Fgtk_clist_hadjustment, 1, 1, 0, /*
+Access the `hadjustment' slot of OBJ, a GtkCList object.
+*/
+       (obj))
+{
+       GtkCList *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_CLIST (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkCList", obj);
+       };
+
+       the_obj = GTK_CLIST (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkAdjustment");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->hadjustment);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-clist-vadjustment", Fgtk_clist_vadjustment, 1, 1, 0, /*
+Access the `vadjustment' slot of OBJ, a GtkCList object.
+*/
+       (obj))
+{
+       GtkCList *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_CLIST (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkCList", obj);
+       };
+
+       the_obj = GTK_CLIST (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkAdjustment");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->vadjustment);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-clist-sort-type", Fgtk_clist_sort_type, 1, 1, 0, /*
+Access the `sort_type' slot of OBJ, a GtkCList object.
+*/
+       (obj))
+{
+       GtkCList *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_CLIST (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkCList", obj);
+       };
+
+       the_obj = GTK_CLIST (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkSortType");
+       GTK_VALUE_ENUM (arg) = the_obj->sort_type;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-clist-focus-row", Fgtk_clist_focus_row, 1, 1, 0, /*
+Access the `focus_row' slot of OBJ, a GtkCList object.
+*/
+       (obj))
+{
+       GtkCList *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_CLIST (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkCList", obj);
+       };
+
+       the_obj = GTK_CLIST (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("gint");
+       GTK_VALUE_INT (arg) = the_obj->focus_row;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-clist-sort-column", Fgtk_clist_sort_column, 1, 1, 0, /*
+Access the `sort_column' slot of OBJ, a GtkCList object.
+*/
+       (obj))
+{
+       GtkCList *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_CLIST (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkCList", obj);
+       };
+
+       the_obj = GTK_CLIST (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("gint");
+       GTK_VALUE_INT (arg) = the_obj->sort_column;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-list-children", Fgtk_list_children, 1, 1, 0, /*
+Access the `children' slot of OBJ, a GtkList object.
+*/
+       (obj))
+{
+       GtkList *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_LIST (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkList", obj);
+       };
+
+       the_obj = GTK_LIST (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkListOfObject");
+       GTK_VALUE_POINTER (arg) = the_obj->children;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-list-selection", Fgtk_list_selection, 1, 1, 0, /*
+Access the `selection' slot of OBJ, a GtkList object.
+*/
+       (obj))
+{
+       GtkList *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_LIST (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkList", obj);
+       };
+
+       the_obj = GTK_LIST (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkListOfObject");
+       GTK_VALUE_POINTER (arg) = the_obj->selection;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-tree-children", Fgtk_tree_children, 1, 1, 0, /*
+Access the `children' slot of OBJ, a GtkTree object.
+*/
+       (obj))
+{
+       GtkTree *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_TREE (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkTree", obj);
+       };
+
+       the_obj = GTK_TREE (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkListOfObject");
+       GTK_VALUE_POINTER (arg) = the_obj->children;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-tree-root-tree", Fgtk_tree_root_tree, 1, 1, 0, /*
+Access the `root_tree' slot of OBJ, a GtkTree object.
+*/
+       (obj))
+{
+       GtkTree *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_TREE (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkTree", obj);
+       };
+
+       the_obj = GTK_TREE (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkTree");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->root_tree);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-tree-tree-owner", Fgtk_tree_tree_owner, 1, 1, 0, /*
+Access the `tree_owner' slot of OBJ, a GtkTree object.
+*/
+       (obj))
+{
+       GtkTree *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_TREE (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkTree", obj);
+       };
+
+       the_obj = GTK_TREE (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->tree_owner);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-tree-selection", Fgtk_tree_selection, 1, 1, 0, /*
+Access the `selection' slot of OBJ, a GtkTree object.
+*/
+       (obj))
+{
+       GtkTree *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_TREE (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkTree", obj);
+       };
+
+       the_obj = GTK_TREE (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkListOfObject");
+       GTK_VALUE_POINTER (arg) = the_obj->selection;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-tree-item-subtree", Fgtk_tree_item_subtree, 1, 1, 0, /*
+Access the `subtree' slot of OBJ, a GtkTreeItem object.
+*/
+       (obj))
+{
+       GtkTreeItem *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_TREE_ITEM (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkTreeItem", obj);
+       };
+
+       the_obj = GTK_TREE_ITEM (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->subtree);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-scrolled-window-hscrollbar", Fgtk_scrolled_window_hscrollbar, 1, 1, 0, /*
+Access the `hscrollbar' slot of OBJ, a GtkScrolledWindow object.
+*/
+       (obj))
+{
+       GtkScrolledWindow *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_SCROLLED_WINDOW (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkScrolledWindow", obj);
+       };
+
+       the_obj = GTK_SCROLLED_WINDOW (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->hscrollbar);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-scrolled-window-vscrollbar", Fgtk_scrolled_window_vscrollbar, 1, 1, 0, /*
+Access the `vscrollbar' slot of OBJ, a GtkScrolledWindow object.
+*/
+       (obj))
+{
+       GtkScrolledWindow *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_SCROLLED_WINDOW (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkScrolledWindow", obj);
+       };
+
+       the_obj = GTK_SCROLLED_WINDOW (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("GtkWidget");
+       GTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->vscrollbar);
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-scrolled-window-hscrollbar-visible", Fgtk_scrolled_window_hscrollbar_visible, 1, 1, 0, /*
+Access the `hscrollbar_visible' slot of OBJ, a GtkScrolledWindow object.
+*/
+       (obj))
+{
+       GtkScrolledWindow *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_SCROLLED_WINDOW (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkScrolledWindow", obj);
+       };
+
+       the_obj = GTK_SCROLLED_WINDOW (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("gboolean");
+       GTK_VALUE_BOOL (arg) = the_obj->hscrollbar_visible;
+       return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-scrolled-window-vscrollbar-visible", Fgtk_scrolled_window_vscrollbar_visible, 1, 1, 0, /*
+Access the `vscrollbar_visible' slot of OBJ, a GtkScrolledWindow object.
+*/
+       (obj))
+{
+       GtkScrolledWindow *the_obj = NULL;
+       GtkArg arg;
+
+       CHECK_GTK_OBJECT (obj);
+
+       if (!GTK_IS_SCROLLED_WINDOW (XGTK_OBJECT (obj)->object))
+       {
+               signal_simple_error ("Object is not a GtkScrolledWindow", obj);
+       };
+
+       the_obj = GTK_SCROLLED_WINDOW (XGTK_OBJECT (obj)->object);
+       arg.type = gtk_type_from_name ("gboolean");
+       GTK_VALUE_BOOL (arg) = the_obj->vscrollbar_visible;
+       return (gtk_type_to_lisp (&arg));
+}
+
+void syms_of_widget_accessors  (void)
+{
+       DEFSUBR (Fgtk_scrolled_window_vscrollbar_visible);
+       DEFSUBR (Fgtk_scrolled_window_hscrollbar_visible);
+       DEFSUBR (Fgtk_scrolled_window_vscrollbar);
+       DEFSUBR (Fgtk_scrolled_window_hscrollbar);
+       DEFSUBR (Fgtk_tree_item_subtree);
+       DEFSUBR (Fgtk_tree_selection);
+       DEFSUBR (Fgtk_tree_tree_owner);
+       DEFSUBR (Fgtk_tree_root_tree);
+       DEFSUBR (Fgtk_tree_children);
+       DEFSUBR (Fgtk_list_selection);
+       DEFSUBR (Fgtk_list_children);
+       DEFSUBR (Fgtk_clist_sort_column);
+       DEFSUBR (Fgtk_clist_focus_row);
+       DEFSUBR (Fgtk_clist_sort_type);
+       DEFSUBR (Fgtk_clist_vadjustment);
+       DEFSUBR (Fgtk_clist_hadjustment);
+       DEFSUBR (Fgtk_clist_columns);
+       DEFSUBR (Fgtk_clist_rows);
+       DEFSUBR (Fgtk_paned_child2_shrink);
+       DEFSUBR (Fgtk_paned_child1_shrink);
+       DEFSUBR (Fgtk_paned_child2_resize);
+       DEFSUBR (Fgtk_paned_child1_resize);
+       DEFSUBR (Fgtk_paned_child2);
+       DEFSUBR (Fgtk_paned_child1);
+       DEFSUBR (Fgtk_object_ref_count);
+       DEFSUBR (Fgtk_object_flags);
+       DEFSUBR (Fgtk_plug_same_app);
+       DEFSUBR (Fgtk_plug_socket_window);
+       DEFSUBR (Fgtk_input_dialog_save_button);
+       DEFSUBR (Fgtk_input_dialog_close_button);
+       DEFSUBR (Fgtk_dialog_action_area);
+       DEFSUBR (Fgtk_dialog_vbox);
+       DEFSUBR (Fgtk_color_selection_dialog_help_button);
+       DEFSUBR (Fgtk_color_selection_dialog_cancel_button);
+       DEFSUBR (Fgtk_color_selection_dialog_reset_button);
+       DEFSUBR (Fgtk_color_selection_dialog_ok_button);
+       DEFSUBR (Fgtk_color_selection_dialog_main_vbox);
+       DEFSUBR (Fgtk_color_selection_dialog_colorsel);
+       DEFSUBR (Fgtk_font_selection_dialog_cancel_button);
+       DEFSUBR (Fgtk_font_selection_dialog_apply_button);
+       DEFSUBR (Fgtk_font_selection_dialog_ok_button);
+       DEFSUBR (Fgtk_font_selection_dialog_action_area);
+       DEFSUBR (Fgtk_font_selection_dialog_main_vbox);
+       DEFSUBR (Fgtk_font_selection_dialog_fontsel);
+       DEFSUBR (Fgtk_file_selection_action_area);
+       DEFSUBR (Fgtk_file_selection_help_button);
+       DEFSUBR (Fgtk_file_selection_cancel_button);
+       DEFSUBR (Fgtk_file_selection_ok_button);
+       DEFSUBR (Fgtk_file_selection_main_vbox);
+       DEFSUBR (Fgtk_file_selection_selection_text);
+       DEFSUBR (Fgtk_file_selection_selection_entry);
+       DEFSUBR (Fgtk_file_selection_file_list);
+       DEFSUBR (Fgtk_file_selection_dir_list);
+       DEFSUBR (Fgtk_text_vadj);
+       DEFSUBR (Fgtk_text_hadj);
+       DEFSUBR (Fgtk_notebook_tab_pos);
+       DEFSUBR (Fgtk_check_menu_item_active);
+       DEFSUBR (Fgtk_gamma_curve_gamma_text);
+       DEFSUBR (Fgtk_gamma_curve_gamma_dialog);
+       DEFSUBR (Fgtk_gamma_curve_gamma);
+       DEFSUBR (Fgtk_gamma_curve_curve);
+       DEFSUBR (Fgtk_gamma_curve_table);
+       DEFSUBR (Fgtk_combo_list);
+       DEFSUBR (Fgtk_combo_popwin);
+       DEFSUBR (Fgtk_combo_popup);
+       DEFSUBR (Fgtk_combo_button);
+       DEFSUBR (Fgtk_combo_entry);
+       DEFSUBR (Fgtk_button_button_down);
+       DEFSUBR (Fgtk_button_in_button);
+       DEFSUBR (Fgtk_button_child);
+       DEFSUBR (Fgtk_widget_parent);
+       DEFSUBR (Fgtk_widget_name);
+       DEFSUBR (Fgtk_widget_state);
+       DEFSUBR (Fgtk_widget_window);
+       DEFSUBR (Fgtk_widget_style);
+       DEFSUBR (Fgtk_adjustment_page_size);
+       DEFSUBR (Fgtk_adjustment_page_increment);
+       DEFSUBR (Fgtk_adjustment_step_increment);
+       DEFSUBR (Fgtk_adjustment_value);
+       DEFSUBR (Fgtk_adjustment_upper);
+       DEFSUBR (Fgtk_adjustment_lower);
+}

diff --git a/src/event-gtk.c b/src/event-gtk.c
new file mode 100644 (file)
index 0000000..9dd0394
--- /dev/null
+++ b/src/event-gtk.c
@@ -0,0 +1,2165 @@
+/* The event_stream interface for X11 with gtk, and/or tty frames.
+   Copyright (C) 1991-5, 1997 Free Software Foundation, Inc.
+   Copyright (C) 1995 Sun Microsystems, Inc.
+   Copyright (C) 1996 Ben Wing.
+   Copyright (C) 2000 William Perry.
+
+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, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* This file is heavily based upon event-Xt.c */
+
+/* Synched up with: Not in FSF. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "console-gtk.h"
+
+#include "blocktype.h"
+#include "buffer.h"
+#include "commands.h"
+#include "console.h"
+#include "console-tty.h"
+#include "events.h"
+#include "frame.h"
+#include "objects-gtk.h"
+#include "process.h"
+#include "redisplay.h"
+#include "elhash.h"
+
+#include "gtk-xemacs.h"
+
+#include "systime.h"
+#include "sysproc.h" /* for MAXDESC */
+
+#ifdef FILE_CODING
+#include "lstream.h"
+#include "file-coding.h"
+#endif
+
+#include <gdk/gdkkeysyms.h>
+
+#ifdef HAVE_DRAGNDROP
+#include "dragdrop.h"
+#endif
+
+#if defined (HAVE_OFFIX_DND)
+#include "offix.h"
+#endif
+
+#include "events-mod.h"
+
+#include <gdk/gdkx.h>
+
+static struct event_stream *gtk_event_stream;
+
+/* Do we accept events sent by other clients? */
+int gtk_allow_sendevents;
+
+static int process_events_occurred;
+static int tty_events_occurred;
+
+/* Mask of bits indicating the descriptors that we wait for input on */
+extern SELECT_TYPE input_wait_mask, process_only_mask, tty_only_mask;
+
+static Lisp_Object gtk_keysym_to_emacs_keysym ();
+void debug_process_finalization (struct Lisp_Process *p);
+gboolean emacs_gtk_event_handler (GtkWidget *wid /* unused */,
+                                 GdkEvent *event,
+                                 gpointer closure /* unused */);
+
+static int last_quit_check_signal_tick_count;
+
+Lisp_Object Qkey_mapping;
+Lisp_Object Qsans_modifiers;
+
+static void enqueue_gtk_dispatch_event (Lisp_Object event);
+
+#define IS_MODIFIER_KEY(keysym)  \
+  ((((keysym) >= GDK_Shift_L) && ((keysym) <= GDK_Hyper_R)) \
+   || ((keysym) == GDK_Mode_switch) \
+   || ((keysym) == GDK_Num_Lock))
+
+
+\f
+/************************************************************************/
+/*                           magic-event handling                       */
+/************************************************************************/
+static void
+handle_focus_event_1 (struct frame *f, int in_p)
+{
+  /* We don't want to handle the focus change now, because we might
+     be in an accept-process-output, sleep-for, or sit-for.  So
+     we enqueue it.
+
+     Actually, we half handle it: we handle it as far as changing the
+     box cursor for redisplay, but we don't call any hooks or do any
+     select-frame stuff until after the sit-for.
+   */
+
+    if (in_p)
+    {
+       GTK_WIDGET_SET_FLAGS (FRAME_GTK_TEXT_WIDGET (f), GTK_HAS_FOCUS);
+    }
+    else
+    {
+       GTK_WIDGET_UNSET_FLAGS (FRAME_GTK_TEXT_WIDGET (f), GTK_HAS_FOCUS);
+    }
+    gtk_widget_grab_focus (FRAME_GTK_TEXT_WIDGET (f));
+    gtk_widget_draw_focus (FRAME_GTK_TEXT_WIDGET (f));
+
+    {
+       Lisp_Object frm;
+       Lisp_Object conser;
+       struct gcpro gcpro1;
+
+       XSETFRAME (frm, f);
+       conser = Fcons (frm, Fcons (FRAME_DEVICE (f), in_p ? Qt : Qnil));
+       GCPRO1 (conser);
+
+       emacs_handle_focus_change_preliminary (conser);
+       enqueue_magic_eval_event (emacs_handle_focus_change_final,
+                                 conser);
+       UNGCPRO;
+    }
+}
+
+/* both GDK_MAP and GDK_VISIBILITY_NOTIFY can cause this
+   JV is_visible has the same semantics as f->visible*/
+static void
+change_frame_visibility (struct frame *f, int is_visible)
+{
+  Lisp_Object frame;
+
+  XSETFRAME (frame, f);
+
+  if (!FRAME_VISIBLE_P (f) && is_visible)
+    {
+      FRAME_VISIBLE_P (f) = is_visible;
+      /* This improves the double flicker when uniconifying a frame
+        some.  A lot of it is not showing a buffer which has changed
+        while the frame was iconified.  To fix it further requires
+        the good 'ol double redisplay structure. */
+      MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (f);
+      va_run_hook_with_args (Qmap_frame_hook, 1, frame);
+    }
+  else if (FRAME_VISIBLE_P (f) && !is_visible)
+    {
+      FRAME_VISIBLE_P (f) = 0;
+      va_run_hook_with_args (Qunmap_frame_hook, 1, frame);
+    }
+  else if (FRAME_VISIBLE_P (f) * is_visible < 0)
+    {
+      FRAME_VISIBLE_P(f) = - FRAME_VISIBLE_P(f);
+      if (FRAME_REPAINT_P (f))
+             MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (f);
+      va_run_hook_with_args (Qmap_frame_hook, 1, frame);
+    }
+}
+
+static void
+handle_map_event (struct frame *f, GdkEvent *event)
+{
+  Lisp_Object frame;
+
+  XSETFRAME (frame, f);
+  if (event->any.type == GDK_MAP)
+    {
+      FRAME_GTK_TOTALLY_VISIBLE_P (f) = 1;
+      change_frame_visibility (f, 1);
+    }
+  else
+    {
+      FRAME_GTK_TOTALLY_VISIBLE_P (f) = 0;
+      change_frame_visibility (f, 0);
+      /* Calling Fframe_iconified_p is the only way we have to
+         correctly update FRAME_ICONIFIED_P */
+      Fframe_iconified_p (frame);
+    }
+}
+
+static void
+handle_client_message (struct frame *f, GdkEvent *event)
+{
+  Lisp_Object frame;
+
+  XSETFRAME (frame, f);
+
+  /* The event-Xt code used to handle WM_DELETE_WINDOW here, but we
+     handle that directly in frame-gtk.c */
+        
+  if (event->client.message_type == gdk_atom_intern ("WM_PROTOCOLS", 0) &&
+          (GdkAtom) event->client.data.l[0] == gdk_atom_intern ("WM_TAKE_FOCUS", 0))
+    {
+      handle_focus_event_1 (f, 1);
+    }
+}
+
+static void
+emacs_gtk_handle_magic_event (struct Lisp_Event *emacs_event)
+{
+  /* This function can GC */
+  GdkEvent *event = &emacs_event->event.magic.underlying_gdk_event;
+  struct frame *f = XFRAME (EVENT_CHANNEL (emacs_event));
+
+  if (!FRAME_LIVE_P (f))
+    return;
+
+  switch (event->any.type)
+    {
+    case GDK_CLIENT_EVENT:
+      handle_client_message (f, event);
+      break;
+
+    case GDK_FOCUS_CHANGE:
+      handle_focus_event_1 (f, event->focus_change.in);
+      break;
+
+    case GDK_MAP:
+    case GDK_UNMAP:
+      handle_map_event (f, event);
+      break;
+
+    case GDK_ENTER_NOTIFY:
+      if (event->crossing.detail != GDK_NOTIFY_INFERIOR)
+       {
+         Lisp_Object frame;
+
+         XSETFRAME (frame, f);
+         /* FRAME_X_MOUSE_P (f) = 1; */
+         va_run_hook_with_args (Qmouse_enter_frame_hook, 1, frame);
+       }
+      break;
+
+    case GDK_LEAVE_NOTIFY:
+      if (event->crossing.detail != GDK_NOTIFY_INFERIOR)
+       {
+         Lisp_Object frame;
+
+         XSETFRAME (frame, f);
+         /* FRAME_X_MOUSE_P (f) = 0; */
+         va_run_hook_with_args (Qmouse_leave_frame_hook, 1, frame);
+       }
+      break;
+
+    case GDK_VISIBILITY_NOTIFY: /* window visiblity has changed */
+      if (event->visibility.window == GET_GTK_WIDGET_WINDOW (FRAME_GTK_SHELL_WIDGET (f)))
+       {
+         FRAME_GTK_TOTALLY_VISIBLE_P (f) =
+           (event->visibility.state == GDK_VISIBILITY_UNOBSCURED);
+         /* Note that the fvwm pager only sends VisibilityNotify when
+            changing pages. Is this all we need to do ? JV */
+         /* Nope.  We must at least trigger a redisplay here.
+            Since this case seems similar to MapNotify, I've
+            factored out some code to change_frame_visibility().
+            This triggers the necessary redisplay and runs
+            (un)map-frame-hook.  - dkindred@cs.cmu.edu */
+         /* Changed it again to support the tristate visibility flag */
+         change_frame_visibility (f, (event->visibility.state
+                                      != GDK_VISIBILITY_FULLY_OBSCURED) ? 1 : -1);
+       }
+      break;
+
+    default:
+      break;
+    }
+}
+
+/************************************************************************/
+/*                 Gtk to Emacs event conversion                        */
+/************************************************************************/
+
+static int
+keysym_obeys_caps_lock_p (guint sym, struct device *d)
+{
+  struct gtk_device *gd = DEVICE_GTK_DATA (d);
+  /* Eeeeevil hack.  Don't apply Caps_Lock to things that aren't alphabetic
+     characters, where "alphabetic" means something more than simply A-Z.
+     That is, if Caps_Lock is down, typing ESC doesn't produce Shift-ESC.
+     But if shift-lock is down, then it does. */
+  if (gd->lock_interpretation == GDK_Shift_Lock)
+    return 1;
+
+  return
+    ((sym >= GDK_A)        && (sym <= GDK_Z))          ||
+    ((sym >= GDK_a)        && (sym <= GDK_z))          ||
+    ((sym >= GDK_Agrave)   && (sym <= GDK_Odiaeresis)) ||
+    ((sym >= GDK_agrave)   && (sym <= GDK_odiaeresis)) ||
+    ((sym >= GDK_Ooblique) && (sym <= GDK_Thorn))      ||
+    ((sym >= GDK_oslash)   && (sym <= GDK_thorn));
+}
+
+static void
+set_last_server_timestamp (struct device *d, GdkEvent *gdk_event)
+{
+  guint32 t;
+  switch (gdk_event->type)
+    {
+    case GDK_KEY_PRESS:
+    case GDK_KEY_RELEASE:      t = gdk_event->key.time; break;
+    case GDK_BUTTON_PRESS:
+    case GDK_2BUTTON_PRESS:
+    case GDK_3BUTTON_PRESS:
+    case GDK_BUTTON_RELEASE:   t = gdk_event->button.time; break;
+    case GDK_ENTER_NOTIFY:
+    case GDK_LEAVE_NOTIFY:     t = gdk_event->crossing.time; break;
+    case GDK_MOTION_NOTIFY:    t = gdk_event->motion.time; break;
+    case GDK_PROPERTY_NOTIFY:  t = gdk_event->property.time; break;
+    case GDK_SELECTION_CLEAR:
+    case GDK_SELECTION_REQUEST:
+    case GDK_SELECTION_NOTIFY: t = gdk_event->selection.time; break;
+    default: return;
+    }
+  DEVICE_GTK_LAST_SERVER_TIMESTAMP (d) = t;
+}
+
+static Lisp_Object
+gtk_keysym_to_emacs_keysym (guint keysym, int simple_p)
+{
+  char *name;
+  if (keysym >= GDK_exclam && keysym <= GDK_asciitilde)
+    /* We must assume that the X keysym numbers for the ASCII graphic
+       characters are the same as their ASCII codes.  */
+    return make_char (keysym);
+
+  switch (keysym)
+    {
+      /* These would be handled correctly by the default case, but by
+        special-casing them here we don't garbage a string or call
+        intern().  */
+    case GDK_BackSpace:        return QKbackspace;
+    case GDK_Tab:      return QKtab;
+    case GDK_Linefeed: return QKlinefeed;
+    case GDK_Return:   return QKreturn;
+    case GDK_Escape:   return QKescape;
+    case GDK_space:    return QKspace;
+    case GDK_Delete:   return QKdelete;
+    case 0:            return Qnil;
+    default:
+      if (simple_p) return Qnil;
+      /* !!#### not Mule-ized */
+      name = gdk_keyval_name (keysym);
+      if (!name || !name[0])
+       /* This happens if there is a mismatch between the Xlib of
+           XEmacs and the Xlib of the X server...
+
+          Let's hard-code in some knowledge of common keysyms introduced
+          in recent X11 releases.  Snarfed from X11/keysymdef.h
+
+          Probably we should add some stuff here for X11R6. */
+       switch (keysym)
+         {
+         case 0xFF95: return KEYSYM ("kp-home");
+         case 0xFF96: return KEYSYM ("kp-left");
+         case 0xFF97: return KEYSYM ("kp-up");
+         case 0xFF98: return KEYSYM ("kp-right");
+         case 0xFF99: return KEYSYM ("kp-down");
+         case 0xFF9A: return KEYSYM ("kp-prior");
+         case 0xFF9B: return KEYSYM ("kp-next");
+         case 0xFF9C: return KEYSYM ("kp-end");
+         case 0xFF9D: return KEYSYM ("kp-begin");
+         case 0xFF9E: return KEYSYM ("kp-insert");
+         case 0xFF9F: return KEYSYM ("kp-delete");
+
+         case 0x1005FF10: return KEYSYM ("SunF36"); /* labeled F11 */
+         case 0x1005FF11: return KEYSYM ("SunF37"); /* labeled F12 */
+         default:
+           {
+             char buf [64];
+             sprintf (buf, "unknown-keysym-0x%X", (int) keysym);
+             return KEYSYM (buf);
+           }
+         }
+      /* If it's got a one-character name, that's good enough. */
+      if (!name[1])
+       return make_char (name[0]);
+
+      /* If it's in the "Keyboard" character set, downcase it.
+        The case of those keysyms is too totally random for us to
+        force anyone to remember them.
+        The case of the other character sets is significant, however.
+        */
+      if ((((unsigned int) keysym) & (~0x1FF)) == ((unsigned int) 0xFE00))
+       {
+         char buf [255];
+         char *s1, *s2;
+         for (s1 = name, s2 = buf; *s1; s1++, s2++) {
+           if (*s1 == '_') {
+             *s2 = '-';
+           } else {
+             *s2 = tolower (* (unsigned char *) s1);
+           }
+         }
+         *s2 = 0;
+         return KEYSYM (buf);
+       }
+      return KEYSYM (name);
+    }
+}
+
+static Lisp_Object
+gtk_to_emacs_keysym (struct device *d, GdkEventKey *event, int simple_p)
+     /* simple_p means don't try too hard (ASCII only) */
+{
+  if (event->length != 1)
+  {
+#ifdef FILE_CODING
+      /* Generate multiple emacs events */
+      Emchar ch;
+      Lisp_Object instream, fb_instream;
+      Lstream *istr;
+      struct gcpro gcpro1, gcpro2;
+
+      fb_instream =
+          make_fixed_buffer_input_stream ((unsigned char *) event->string, event->length);
+
+      /* ### Use Fget_coding_system (Vcomposed_input_coding_system) */
+      instream =
+         make_decoding_input_stream (XLSTREAM (fb_instream),
+                                     Fget_coding_system (Qundecided));
+      
+      istr = XLSTREAM (instream);
+
+      GCPRO2 (instream, fb_instream);
+      while ((ch = Lstream_get_emchar (istr)) != EOF)
+      {
+         Lisp_Object emacs_event = Fmake_event (Qnil, Qnil);
+         struct Lisp_Event *ev = XEVENT (emacs_event);
+         ev->channel       = DEVICE_CONSOLE (d);
+         ev->event_type    = key_press_event;
+         ev->timestamp     = event->time;
+         ev->event.key.modifiers = 0;
+         ev->event.key.keysym    = make_char (ch);
+         enqueue_gtk_dispatch_event (emacs_event);
+      }
+      Lstream_close (istr);
+      UNGCPRO;
+      Lstream_delete (istr);
+      Lstream_delete (XLSTREAM (fb_instream));
+#else
+      int i;
+      for (i = 0; i < event->length; i++)
+      {
+         Lisp_Object emacs_event = Fmake_event (Qnil, Qnil);
+         struct Lisp_Event *ev = XEVENT (emacs_event);
+         ev->channel       = DEVICE_CONSOLE (d);
+         ev->event_type    = key_press_event;
+         ev->timestamp     = event->time;
+         ev->event.key.modifiers = 0;
+         ev->event.key.keysym    = make_char (event->string[i]);
+         enqueue_gtk_dispatch_event (emacs_event);
+      }
+#endif
+      if (IS_MODIFIER_KEY (event->keyval) || (event->keyval == GDK_Mode_switch))
+         return (Qnil);
+      return (gtk_keysym_to_emacs_keysym (event->keyval, simple_p));
+  }
+  else
+  {
+      if (IS_MODIFIER_KEY (event->keyval) || (event->keyval == GDK_Mode_switch))
+         return (Qnil);
+      return (gtk_keysym_to_emacs_keysym (event->keyval, simple_p));
+  }
+}
+
+\f
+/************************************************************************/
+/*                             timeout events                          */
+/************************************************************************/
+
+static int timeout_id_tick;
+
+struct GTK_timeout {
+    int id;
+    guint timeout_id;
+    struct GTK_timeout *next;
+} *pending_timeouts, *completed_timeouts;
+
+struct GTK_timeout_blocktype
+{
+  Blocktype_declare (struct GTK_timeout);
+} *the_GTK_timeout_blocktype;
+
+/* called by the gtk main loop */
+static gint
+gtk_timeout_callback (gpointer closure)
+{
+  struct GTK_timeout *timeout = (struct GTK_timeout *) closure;
+  struct GTK_timeout *t2 = pending_timeouts;
+
+  /* Remove this one from the list of pending timeouts */
+  if (t2 == timeout)
+    pending_timeouts = pending_timeouts->next;
+  else
+    {
+      while (t2->next && t2->next != timeout) t2 = t2->next;
+      assert (t2->next);
+      t2->next = t2->next->next;
+    }
+  /* Add this one to the list of completed timeouts */
+  timeout->next = completed_timeouts;
+  completed_timeouts = timeout;
+  return(FALSE);
+}
+
+static int
+emacs_gtk_add_timeout (EMACS_TIME thyme)
+{
+  struct GTK_timeout *timeout = Blocktype_alloc (the_GTK_timeout_blocktype);
+  EMACS_TIME current_time;
+  int milliseconds;
+
+  timeout->id = timeout_id_tick++;
+  timeout->next = pending_timeouts;
+  pending_timeouts = timeout;
+  EMACS_GET_TIME (current_time);
+  EMACS_SUB_TIME (thyme, thyme, current_time);
+  milliseconds = EMACS_SECS (thyme) * 1000 +
+    EMACS_USECS (thyme) / 1000;
+  if (milliseconds < 1)
+    milliseconds = 1;
+  timeout->timeout_id = gtk_timeout_add (milliseconds,
+                                        gtk_timeout_callback,
+                                        (gpointer) timeout);
+  return timeout->id;
+}
+
+static void
+emacs_gtk_remove_timeout (int id)
+{
+  struct GTK_timeout *timeout, *t2;
+
+  timeout = NULL;
+  
+  /* Find the timeout on the list of pending ones, if it's still there. */
+  if (pending_timeouts)
+    {
+      if (id == pending_timeouts->id)
+       {
+         timeout = pending_timeouts;
+         pending_timeouts = pending_timeouts->next;
+       }
+      else
+       {
+         t2 = pending_timeouts;
+         while (t2->next && t2->next->id != id) t2 = t2->next;
+         if ( t2->next)   /*found it */
+           {
+             timeout = t2->next;
+             t2->next = t2->next->next;
+           }
+       }
+      /* if it was pending, we have removed it from the list */
+      if (timeout)
+         gtk_timeout_remove (timeout->timeout_id);
+    }
+
+  /* It could be that the call back was already called but we didn't convert
+     into an Emacs event yet */
+  if (!timeout && completed_timeouts)
+    {
+      /* Code duplication! */
+      if (id == completed_timeouts->id)
+       {
+         timeout = completed_timeouts;
+         completed_timeouts = completed_timeouts->next;
+       }
+      else
+       {
+         t2 = completed_timeouts;
+         while (t2->next && t2->next->id != id) t2 = t2->next;
+         if ( t2->next)   /*found it */
+           {
+             timeout = t2->next;
+             t2->next = t2->next->next;
+           }
+       }
+    }
+
+  /* If we found the thing on the lists of timeouts,
+     and removed it, deallocate
+  */
+  if (timeout)
+    Blocktype_free (the_GTK_timeout_blocktype, timeout);
+}
+
+static void
+gtk_timeout_to_emacs_event (struct Lisp_Event *emacs_event)
+{
+  struct GTK_timeout *timeout = completed_timeouts;
+  assert (timeout);
+  completed_timeouts = completed_timeouts->next;
+  emacs_event->event_type = timeout_event;
+  /* timeout events have nil as channel */
+  emacs_event->timestamp  = 0; /* #### wrong!! */
+  emacs_event->event.timeout.interval_id = timeout->id;
+  Blocktype_free (the_GTK_timeout_blocktype, timeout);
+}
+
+\f
+/************************************************************************/
+/*                     process and tty events                          */
+/************************************************************************/
+
+struct what_is_ready_closure
+{
+  int fd;
+  Lisp_Object what;
+  gint id;
+};
+
+static Lisp_Object *filedesc_with_input;
+static struct what_is_ready_closure **filedesc_to_what_closure;
+
+static void
+init_what_input_once (void)
+{
+  int i;
+
+  filedesc_with_input = xnew_array (Lisp_Object, MAXDESC);
+  filedesc_to_what_closure =
+    xnew_array (struct what_is_ready_closure *, MAXDESC);
+
+  for (i = 0; i < MAXDESC; i++)
+    {
+      filedesc_to_what_closure[i] = 0;
+      filedesc_with_input[i] = Qnil;
+    }
+
+  process_events_occurred = 0;
+  tty_events_occurred = 0;
+}
+
+static void
+mark_what_as_being_ready (struct what_is_ready_closure *closure)
+{
+  if (NILP (filedesc_with_input[closure->fd]))
+    {
+      SELECT_TYPE temp_mask;
+      FD_ZERO (&temp_mask);
+      FD_SET (closure->fd, &temp_mask);
+      /* Check to make sure there's *really* input available.
+        Sometimes things seem to get confused and this gets called
+        for the tty fd when there's really only input available
+        on some process's fd.  (It will subsequently get called
+        for that process's fd, so returning without setting any
+        flags will take care of it.)  To see the problem, uncomment
+        the stderr_out below, turn NORMAL_QUIT_CHECK_TIMEOUT_MSECS
+        down to 25, do sh -c 'xemacs -nw -q -f shell 2>/tmp/log'
+        and press return repeatedly.  (Seen under AIX & Linux.)
+        -dkindred@cs.cmu.edu */
+      if (!poll_fds_for_input (temp_mask))
+       {
+#if 0
+         stderr_out ("mark_what_as_being_ready: no input available (fd=%d)\n",
+                     closure->fd);
+#endif
+         return;
+       }
+      filedesc_with_input[closure->fd] = closure->what;
+      if (PROCESSP (closure->what))
+       {
+         /* Don't increment this if the current process is already marked
+          *  as having input. */
+         process_events_occurred++;
+       }
+      else
+       {
+         tty_events_occurred++;
+       }
+    }
+}
+
+static void
+gtk_what_callback (gpointer closure, gint source, GdkInputCondition why)
+{
+  /* If closure is 0, then we got a fake event from a signal handler.
+     The only purpose of this is to make XtAppProcessEvent() stop
+     blocking. */
+  if (closure)
+    mark_what_as_being_ready ((struct what_is_ready_closure *) closure);
+  else
+    {
+      fake_event_occurred++;
+      drain_signal_event_pipe ();
+    }
+}
+
+static void
+select_filedesc (int fd, Lisp_Object what)
+{
+  struct what_is_ready_closure *closure;
+
+  /* If somebody is trying to select something that's already selected
+     for, then something went wrong.  The generic routines ought to
+     detect this and error before here. */
+  assert (!filedesc_to_what_closure[fd]);
+
+  closure = xnew (struct what_is_ready_closure);
+  closure->fd = fd;
+  closure->what = what;
+  closure->id = gdk_input_add (fd, GDK_INPUT_READ,
+                              (GdkInputFunction) gtk_what_callback, closure);
+  filedesc_to_what_closure[fd] = closure;
+}
+
+static void
+unselect_filedesc (int fd)
+{
+  struct what_is_ready_closure *closure = filedesc_to_what_closure[fd];
+
+  assert (closure);
+  if (!NILP (filedesc_with_input[fd]))
+    {
+      /* We are unselecting this process before we have drained the rest of
+        the input from it, probably from status_notify() in the command loop.
+        This can happen like so:
+
+         - We are waiting in XtAppNextEvent()
+         - Process generates output
+         - Process is marked as being ready
+         - Process dies, SIGCHLD gets generated before we return (!?)
+           It could happen I guess.
+         - sigchld_handler() marks process as dead
+         - Somehow we end up getting a new KeyPress event on the queue
+           at the same time (I'm really so sure how that happens but I'm
+           not sure it can't either so let's assume it can...).
+         - Key events have priority so we return that instead of the proc.
+         - Before dispatching the lisp key event we call status_notify()
+         - Which deselects the process that SIGCHLD marked as dead.
+
+        Thus we never remove it from _with_input and turn it into a lisp
+        event, so we need to do it here.  But this does not mean that we're
+        throwing away the last block of output - status_notify() has already
+        taken care of running the proc filter or whatever.
+       */
+      filedesc_with_input[fd] = Qnil;
+      if (PROCESSP (closure->what))
+       {
+         assert (process_events_occurred > 0);
+         process_events_occurred--;
+       }
+      else
+       {
+         assert (tty_events_occurred > 0);
+         tty_events_occurred--;
+       }
+    }
+  gdk_input_remove (closure->id);
+  xfree (closure);
+  filedesc_to_what_closure[fd] = 0;
+}
+
+static void
+emacs_gtk_select_process (struct Lisp_Process *p)
+{
+  Lisp_Object process;
+  int infd = event_stream_unixoid_select_process (p);
+
+  XSETPROCESS (process, p);
+  select_filedesc (infd, process);
+}
+
+static void
+emacs_gtk_unselect_process (struct Lisp_Process *p)
+{
+  int infd = event_stream_unixoid_unselect_process (p);
+
+  unselect_filedesc (infd);
+}
+
+static USID
+emacs_gtk_create_stream_pair (void* inhandle, void* outhandle,
+                             Lisp_Object* instream, Lisp_Object* outstream, int flags)
+{
+    USID u = event_stream_unixoid_create_stream_pair
+       (inhandle, outhandle, instream, outstream, flags);
+    if (u != USID_ERROR)
+       u = USID_DONTHASH;
+    return u;
+}
+
+static USID
+emacs_gtk_delete_stream_pair (Lisp_Object instream, Lisp_Object outstream)
+{
+  event_stream_unixoid_delete_stream_pair (instream, outstream);
+  return USID_DONTHASH;
+}
+
+/* This is called from GC when a process object is about to be freed.
+   If we've still got pointers to it in this file, we're gonna lose hard.
+ */
+void
+debug_process_finalization (struct Lisp_Process *p)
+{
+#if 0 /* #### */
+  int i;
+  Lisp_Object instr, outstr;
+
+  get_process_streams (p, &instr, &outstr);
+  /* if it still has fds, then it hasn't been killed yet. */
+  assert (NILP(instr));
+  assert (NILP(outstr));
+  /* Better not still be in the "with input" table; we know it's got no fds. */
+  for (i = 0; i < MAXDESC; i++)
+    {
+      Lisp_Object process = filedesc_fds_with_input [i];
+      assert (!PROCESSP (process) || XPROCESS (process) != p);
+    }
+#endif
+}
+
+static void
+gtk_process_to_emacs_event (struct Lisp_Event *emacs_event)
+{
+  int i;
+  Lisp_Object process;
+
+  assert (process_events_occurred > 0);
+  for (i = 0; i < MAXDESC; i++)
+    {
+      process = filedesc_with_input[i];
+      if (PROCESSP (process))
+       break;
+    }
+  assert (i < MAXDESC);
+  filedesc_with_input[i] = Qnil;
+  process_events_occurred--;
+  /* process events have nil as channel */
+  emacs_event->event_type = process_event;
+  emacs_event->timestamp  = 0; /* #### */
+  emacs_event->event.process.process = process;
+}
+
+static void
+emacs_gtk_select_console (struct console *con)
+{
+  Lisp_Object console;
+  int infd;
+
+  if (CONSOLE_GTK_P (con))
+    return; /* Gtk consoles are automatically selected for when we initialize them */
+  infd = event_stream_unixoid_select_console (con);
+  XSETCONSOLE (console, con);
+  select_filedesc (infd, console);
+}
+
+static void
+emacs_gtk_unselect_console (struct console *con)
+{
+  Lisp_Object console;
+  int infd;
+
+  if (CONSOLE_GTK_P (con))
+       return; /* X consoles are automatically selected for when we initialize them */
+  infd = event_stream_unixoid_unselect_console (con);
+  XSETCONSOLE (console, con);
+  unselect_filedesc (infd);
+}
+
+/* read an event from a tty, if one is available.  Returns non-zero
+   if an event was available.  Note that when this function is
+   called, there should always be a tty marked as ready for input.
+   However, the input condition might actually be EOF, so there
+   may not really be any input available. (In this case,
+   read_event_from_tty_or_stream_desc() will arrange for the TTY device
+   to be deleted.) */
+
+static int
+gtk_tty_to_emacs_event (struct Lisp_Event *emacs_event)
+{
+  int i;
+
+  assert (tty_events_occurred > 0);
+  for (i = 0; i < MAXDESC; i++)
+    {
+      Lisp_Object console = filedesc_with_input[i];
+      if (CONSOLEP (console))
+       {
+         assert (tty_events_occurred > 0);
+         tty_events_occurred--;
+         filedesc_with_input[i] = Qnil;
+         if (read_event_from_tty_or_stream_desc
+             (emacs_event, XCONSOLE (console), i))
+           return 1;
+       }
+    }
+
+  return 0;
+}
+
+\f
+/************************************************************************/
+/*                     Drag 'n Drop handling                           */
+/************************************************************************/
+#ifdef HAVE_DRAGNDROP
+#define TARGET_URI_LIST   0x00
+#define TARGET_TEXT_PLAIN 0x01
+#define TARGET_FILE_NAME  0x02
+#define TARGET_NETSCAPE   0x03
+
+static GdkAtom preferred_targets[10];
+
+void
+dragndrop_data_received (GtkWidget          *widget,
+                        GdkDragContext     *context,
+                        gint                x,
+                        gint                y,
+                        GtkSelectionData   *data,
+                        guint               info,
+                        guint               time)
+{
+  Lisp_Object event = Fmake_event (Qnil, Qnil);
+  struct device *d = gtk_any_window_to_device (widget->window);
+  struct frame *f = gtk_any_widget_or_parent_to_frame (d, widget);
+  struct Lisp_Event *ev = XEVENT (event);
+  Lisp_Object l_type = Qnil, l_data = Qnil;
+  Lisp_Object l_dndlist = Qnil, l_item = Qnil;
+  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+
+  GCPRO4 (l_type, l_data, l_dndlist, l_item);
+
+  ev->event_type = misc_user_event;
+  ev->timestamp = time;
+
+  XSETFRAME (ev->channel, f);
+
+  ev->event.misc.x = x;
+  ev->event.misc.y = y;
+
+  if (data->type == preferred_targets[TARGET_URI_LIST])
+    {
+      /* newline-separated list of URLs */
+      int start, end;
+      const char *string_data = (char *) data->data;
+
+      l_type = Qdragdrop_URL;
+
+      for (start = 0, end = 0; string_data && string_data[end]; end++)
+       {
+         if ((string_data[end] == '\r') && (string_data[end+1] == '\n'))
+           {
+             l_item = make_string (&string_data[start], end - start);
+             l_dndlist = Fcons (l_item, l_dndlist);
+             ++end;
+             start = ++end;
+           }
+       }
+    }
+  else if (data->type == preferred_targets[TARGET_TEXT_PLAIN])
+    {
+      /* Arbitrary string */
+      l_type = Qdragdrop_MIME;
+      l_dndlist = list1 (list3 (list1 (build_string ("text/plain")),
+                               build_string ("8_bit"),
+                               make_ext_string (data->data,
+                                                strlen ((char *)data->data),
+                                                Qctext)));
+    }
+  else if (data->type == preferred_targets[TARGET_FILE_NAME])
+    {
+      /* Random filename */
+      char *hurl = dnd_url_hexify_string (data->data, "file:");
+
+      l_dndlist = list1 (make_string ((Bufbyte *)hurl, strlen (hurl)));
+      l_type = Qdragdrop_URL;
+
+      xfree (hurl);
+    }
+  else if (data->type == preferred_targets[TARGET_NETSCAPE])
+    {
+      /* Single URL */
+      l_dndlist = list1 (make_string ((Extbyte *)data->data, 
+                                     strlen ((char *)data->data)));
+      l_type = Qdragdrop_URL;
+    }
+  else
+    {
+      /* Unknown type - what to do?
+        We just pass it up to lisp - we already have a mime type.
+      */
+      l_type = Qdragdrop_MIME;
+      l_dndlist = list1 (list3 (list1 (build_string (gdk_atom_name (data->type))),
+                               build_string ("8bit"),
+                               make_ext_string ((Extbyte *) data->data,
+                                                data->length, Qbinary)));
+    }
+
+  ev->event.misc.function = Qdragdrop_drop_dispatch;
+  ev->event.misc.object = Fcons (l_type, l_dndlist);
+
+  UNGCPRO;
+
+  gtk_drag_finish (context, TRUE, FALSE, time);
+  enqueue_gtk_dispatch_event (event);
+}
+
+gboolean
+dragndrop_dropped (GtkWidget *widget,
+                  GdkDragContext *drag_context,
+                  gint x,
+                  gint y,
+                  guint time,
+                  gpointer user_data)
+{
+  /* Netscape drops things like:
+     STRING
+     _SGI_ICON
+     _SGI_ICON_TYPE
+     SGI_FILE
+     FILE_NAME
+     _NETSCAPE_URL
+
+     gmc drops things like
+     application/x-mc-desktop-icon
+     text/uri-list
+     text/plain
+     _NETSCAPE_URL
+
+     We prefer:
+     text/uri-list
+     text/plain
+     FILE_NAME
+     _NETSCAPE_URL
+     first one
+  */
+  GdkAtom found = 0;
+  GList *list = drag_context->targets;
+
+  int i;
+
+  if (!preferred_targets[0])
+    {
+      preferred_targets[TARGET_URI_LIST]   = gdk_atom_intern ("text/uri-list", FALSE);
+      preferred_targets[TARGET_TEXT_PLAIN] = gdk_atom_intern ("text/plain", FALSE);
+      preferred_targets[TARGET_FILE_NAME]  = gdk_atom_intern ("FILE_NAME", FALSE);
+      preferred_targets[TARGET_NETSCAPE]   = gdk_atom_intern ("_NETSCAPE_URL", FALSE);
+    }
+
+#if 0
+  stderr_out ("Drop info available in the following formats: \n");
+  while (list)
+    {
+      stderr_out ("\t%s\n", gdk_atom_name ((GdkAtom)list->data));
+      list = list->next;
+    }
+  list = drag_context->targets;
+#endif
+
+  while (list && !found)
+    {
+      for (i = 0; preferred_targets[i] && !found; i++)
+       {
+         if ((GdkAtom) list->data == preferred_targets[i])
+           {
+             found = (GdkAtom) list->data;
+           }
+       }
+      list = list->next;
+    }
+
+  if (!found)
+    {
+      found = (GdkAtom) drag_context->targets->data;
+    }
+
+  gtk_drag_get_data (GTK_WIDGET (user_data), drag_context, found, time);
+  return (TRUE);
+}
+#endif /* HAVE_DRAGNDROP */
+
+\f
+/************************************************************************/
+/*                     get the next event from gtk                     */
+/************************************************************************/
+
+static Lisp_Object dispatch_event_queue, dispatch_event_queue_tail;
+
+static void
+enqueue_gtk_dispatch_event (Lisp_Object event)
+{
+  enqueue_event (event, &dispatch_event_queue, &dispatch_event_queue_tail);
+}
+
+static Lisp_Object
+dequeue_gtk_dispatch_event (void)
+{
+  return dequeue_event (&dispatch_event_queue, &dispatch_event_queue_tail);
+}
+
+/* This business exists because menu events "happen" when
+   menubar_selection_callback() is called from somewhere deep
+   within XtAppProcessEvent in emacs_Xt_next_event().  The
+   callback needs to terminate the modal loop in that function
+   or else it will continue waiting until another event is
+   received.
+
+   Same business applies to scrollbar events. */
+
+void
+signal_special_gtk_user_event (Lisp_Object channel, Lisp_Object function,
+                             Lisp_Object object)
+{
+  Lisp_Object event = Fmake_event (Qnil, Qnil);
+
+  XEVENT (event)->event_type = misc_user_event;
+  XEVENT (event)->channel = channel;
+  XEVENT (event)->event.eval.function = function;
+  XEVENT (event)->event.eval.object = object;
+
+  enqueue_gtk_dispatch_event (event);
+}
+
+static void
+emacs_gtk_next_event (struct Lisp_Event *emacs_event)
+{
+ we_didnt_get_an_event:
+
+  while (NILP (dispatch_event_queue) &&
+        !completed_timeouts         &&
+        !fake_event_occurred        &&
+        !process_events_occurred    &&
+        !tty_events_occurred)
+    {
+      gtk_main_iteration();
+    }
+
+  if (!NILP (dispatch_event_queue))
+    {
+      Lisp_Object event, event2;
+      XSETEVENT (event2, emacs_event);
+      event = dequeue_gtk_dispatch_event ();
+      Fcopy_event (event, event2);
+      Fdeallocate_event (event);
+    }
+  else if (tty_events_occurred)
+    {
+      if (!gtk_tty_to_emacs_event (emacs_event))
+       goto we_didnt_get_an_event;
+    }
+  else if (completed_timeouts)
+    gtk_timeout_to_emacs_event (emacs_event);
+  else if (fake_event_occurred)
+    {
+      /* A dummy event, so that a cycle of the command loop will occur. */
+      fake_event_occurred = 0;
+      /* eval events have nil as channel */
+      emacs_event->event_type = eval_event;
+      emacs_event->event.eval.function = Qidentity;
+      emacs_event->event.eval.object = Qnil;
+    }
+  else /* if (process_events_occurred) */
+    gtk_process_to_emacs_event (emacs_event);
+}
+
+int
+gtk_event_to_emacs_event (struct frame *frame, GdkEvent *gdk_event, struct Lisp_Event *emacs_event)
+{
+  struct device *d = NULL;
+  struct gtk_device *gd = NULL;
+  gboolean accept_any_window = FALSE;
+
+  if (!frame)
+    {
+      frame = XFRAME (Fselected_frame (Vdefault_gtk_device));
+      accept_any_window = TRUE;
+    }
+
+  d = XDEVICE (FRAME_DEVICE (frame));
+  gd = DEVICE_GTK_DATA (d);
+
+  set_last_server_timestamp (d, gdk_event);
+
+  switch (gdk_event->type)
+    {
+      /* XEmacs handles double and triple clicking on its own, and if
+         we capture these events, it royally confuses the code in
+         ../lisp/mouse.el */
+    case GDK_2BUTTON_PRESS:
+    case GDK_3BUTTON_PRESS:
+      return (0);
+
+    case GDK_BUTTON_PRESS:
+    case GDK_BUTTON_RELEASE:
+       /* We need to ignore button events outside our main window or
+          things get ugly.  The standard scrollbars in Gtk try to be
+          nice and pass the button press events up to the parent
+          widget.  This causes us no end of grief though.  Effects
+          range from setting point to the wrong place to selecting
+          new windows. */
+      {
+       GdkWindow *w = gdk_window_at_pointer (NULL, NULL);
+
+       /* If you press mouse button and drag it around, and release
+           it outside the window, you will get a NULL GdkWindow at
+           pointer.  We need to forward these events on to XEmacs so
+           that the mouse selection voodoo works.
+       */
+       if (w && (w != gdk_window_lookup (GDK_ROOT_WINDOW ())))
+         {
+           GdkEvent ev;
+           GtkWidget *wid = NULL;
+
+           ev.any.window = w;
+           wid = gtk_get_event_widget (&ev);
+
+           if (!GTK_IS_XEMACS (wid) && !accept_any_window)
+             {
+               return (0);
+             }
+         }
+       if (!accept_any_window)
+         gtk_widget_grab_focus (FRAME_GTK_TEXT_WIDGET (frame));
+      }
+      /* Fall through */
+    case GDK_KEY_PRESS:
+      {
+       unsigned int modifiers = 0;
+       int shift_p, lock_p;
+       gboolean key_event_p = (gdk_event->type == GDK_KEY_PRESS);
+       unsigned int *state =
+         key_event_p ? &gdk_event->key.state : &gdk_event->button.state;
+
+       /* If this is a synthetic KeyPress or Button event, and the user
+          has expressed a disinterest in this security hole, then drop
+          it on the floor. */
+       /* #### BILL!!! Should this be a generic check for ANY synthetic
+          event? */
+       if ((gdk_event->any.send_event) && !gtk_allow_sendevents)
+         return 0;
+
+       DEVICE_GTK_MOUSE_TIMESTAMP (d) =
+         DEVICE_GTK_GLOBAL_MOUSE_TIMESTAMP (d) =
+         key_event_p ? gdk_event->key.time : gdk_event->button.time;
+
+       if (*state & GDK_CONTROL_MASK)    modifiers |= XEMACS_MOD_CONTROL;
+       if (*state & gd->MetaMask)   modifiers |= XEMACS_MOD_META;
+       if (*state & gd->SuperMask)  modifiers |= XEMACS_MOD_SUPER;
+       if (*state & gd->HyperMask)  modifiers |= XEMACS_MOD_HYPER;
+       if (*state & gd->AltMask)    modifiers |= XEMACS_MOD_ALT;
+
+       /* Ignore the Caps_Lock key if:
+          - any other modifiers are down, so that Caps_Lock doesn't
+          turn C-x into C-X, which would suck.
+          - the event was a mouse event. */
+       if (modifiers || ! key_event_p)
+          *state &= (~GDK_LOCK_MASK);
+
+       shift_p = *state & GDK_SHIFT_MASK;
+       lock_p  = *state & GDK_LOCK_MASK;
+
+       if (shift_p || lock_p)
+         modifiers |= XEMACS_MOD_SHIFT;
+
+       if (key_event_p)
+         {
+           GdkEventKey *key_event = &gdk_event->key;
+           Lisp_Object keysym;
+
+           /* This used to compute the frame from the given X window and
+              store it here, but we really don't care about the frame. */
+           emacs_event->channel = DEVICE_CONSOLE (d);
+
+           /* Keysym mucking has already been done inside the
+               GdkEventKey parsing */
+           keysym = gtk_to_emacs_keysym (d, key_event, 0);
+
+           /* If the emacs keysym is nil, then that means that the X
+              keysym was either a Modifier or NoSymbol, which
+              probably means that we're in the midst of reading a
+              Multi_key sequence, or a "dead" key prefix, or XIM
+              input. Ignore it. */
+           if (NILP (keysym))
+             return 0;
+
+           /* More Caps_Lock garbage: Caps_Lock should *only* add the
+              shift modifier to two-case keys (that is, A-Z and
+              related characters). So at this point (after looking up
+              the keysym) if the keysym isn't a dual-case alphabetic,
+              and if the caps lock key was down but the shift key
+              wasn't, then turn off the shift modifier.  Gag barf */
+           /* #### type lossage: assuming equivalence of emacs and
+              X keysyms */
+           /* !!#### maybe fix for Mule */
+           if (lock_p && !shift_p &&
+               ! (CHAR_OR_CHAR_INTP (keysym)
+                  && keysym_obeys_caps_lock_p
+                  ((guint) XCHAR_OR_CHAR_INT (keysym), d)))
+             modifiers &= (~XEMACS_MOD_SHIFT);
+
+           /* If this key contains two distinct keysyms, that is,
+              "shift" generates a different keysym than the
+              non-shifted key, then don't apply the shift modifier
+              bit: it's implicit.  Otherwise, if there would be no
+              other way to tell the difference between the shifted
+              and unshifted version of this key, apply the shift bit.
+              Non-graphics, like Backspace and F1 get the shift bit
+              in the modifiers slot.  Neither the characters "a",
+              "A", "2", nor "@" normally have the shift bit set.
+              However, "F1" normally does. */
+           if (modifiers & XEMACS_MOD_SHIFT)
+             {
+               if (CHAR_OR_CHAR_INTP (keysym))
+                 {
+                   modifiers &= ~XEMACS_MOD_SHIFT;
+                 }
+             }
+               
+           emacs_event->event_type          = key_press_event;
+           emacs_event->timestamp           = key_event->time;
+           emacs_event->event.key.modifiers = modifiers;
+           emacs_event->event.key.keysym    = keysym;
+         }
+       else                    /* Mouse press/release event */
+         {
+           GdkEventButton *button_event = &gdk_event->button;
+           XSETFRAME (emacs_event->channel, frame);
+
+           emacs_event->event_type = (button_event->type == GDK_BUTTON_RELEASE) ?
+             button_release_event : button_press_event;
+
+           emacs_event->event.button.modifiers = modifiers;
+           emacs_event->timestamp              = button_event->time;
+           emacs_event->event.button.button    = button_event->button;
+           emacs_event->event.button.x         = button_event->x;
+           emacs_event->event.button.y         = button_event->y;
+         }
+      }
+      break;
+    case GDK_KEY_RELEASE:
+       return 0;
+       break;
+    case GDK_MOTION_NOTIFY:
+      {
+        GdkEventMotion *ev = &gdk_event->motion;
+        unsigned int modifiers = 0;
+       gint x,y;
+       GdkModifierType mask;
+
+        /* We use MOTION_HINT_MASK, so we will get only one motion
+           event until the next time we call gdk_window_get_pointer or
+           the user clicks the mouse.  So call gdk_window_get_pointer
+           now (meaning that the event will be in sync with the server
+           just before Fnext_event() returns).  If the mouse is still
+           in motion, then the server will immediately generate
+           exactly one more motion event, which will be on the queue
+           waiting for us next time around. */
+       gdk_window_get_pointer (ev->window, &x, &y, &mask);
+
+        DEVICE_GTK_MOUSE_TIMESTAMP (d) = ev->time;
+
+        XSETFRAME (emacs_event->channel, frame);
+        emacs_event->event_type            = pointer_motion_event;
+        emacs_event->timestamp      = ev->time;
+        emacs_event->event.motion.x = x;
+        emacs_event->event.motion.y = y;
+        if (mask & GDK_SHIFT_MASK)     modifiers |= XEMACS_MOD_SHIFT;
+        if (mask & GDK_CONTROL_MASK)   modifiers |= XEMACS_MOD_CONTROL;
+        if (mask & gd->MetaMask)       modifiers |= XEMACS_MOD_META;
+        if (mask & gd->SuperMask)      modifiers |= XEMACS_MOD_SUPER;
+        if (mask & gd->HyperMask)      modifiers |= XEMACS_MOD_HYPER;
+        if (mask & gd->AltMask)        modifiers |= XEMACS_MOD_ALT;
+        /* Currently ignores Shift_Lock but probably shouldn't
+           (but it definitely should ignore Caps_Lock). */
+        emacs_event->event.motion.modifiers = modifiers;
+      }
+    break;
+
+    default: /* it's a magic event */
+      return (0);
+       break;
+    }
+  return 1;
+}
+
+static const char *event_name (GdkEvent *);
+
+static gboolean
+generic_event_handler (GtkWidget *widget, GdkEvent *event)
+{
+    Lisp_Object emacs_event = Qnil;
+    if (!GTK_IS_XEMACS (widget))
+    {
+       stderr_out ("Got a %s event for a non-XEmacs widget\n",event_name (event));
+       return (FALSE);
+    }
+
+    emacs_event = Fmake_event (Qnil, Qnil);
+
+    if (gtk_event_to_emacs_event (GTK_XEMACS_FRAME (widget), event, XEVENT (emacs_event)))
+    {
+       enqueue_gtk_dispatch_event (emacs_event);
+       return (TRUE);
+    }
+    else
+    {
+       Fdeallocate_event (emacs_event);
+    }
+    return (FALSE);
+}
+
+gint emacs_gtk_key_event_handler(GtkWidget *widget, GdkEventKey *event)
+{
+    return (generic_event_handler (widget, (GdkEvent *) event));
+}
+
+gint emacs_gtk_button_event_handler(GtkWidget *widget, GdkEventButton *event)
+{
+    return (generic_event_handler (widget, (GdkEvent *) event));
+}
+
+gint emacs_gtk_motion_event_handler (GtkWidget *widget, GdkEventMotion *event)
+{
+    return (generic_event_handler (widget, (GdkEvent *) event));
+}
+
+gboolean
+emacs_shell_event_handler (GtkWidget *wid /* unused */,
+                          GdkEvent *event,
+                          gpointer closure)
+{
+    struct frame *frame = (struct frame *) closure;
+    Lisp_Object lisp_event = Fmake_event (Qnil, Qnil);
+    struct Lisp_Event *emacs_event = XEVENT (lisp_event);
+    GdkEvent *gdk_event_copy = &emacs_event->event.magic.underlying_gdk_event;
+    struct device *d = XDEVICE (FRAME_DEVICE (frame));
+    gboolean ignore_p = FALSE;
+
+    set_last_server_timestamp (d, event);
+
+#define FROB(event_member) gdk_event_copy->event_member = event->event_member
+
+    switch (event->type)
+    {
+    case GDK_SELECTION_REQUEST:
+    case GDK_SELECTION_CLEAR:
+    case GDK_SELECTION_NOTIFY:  FROB(selection); break;
+    case GDK_PROPERTY_NOTIFY:   FROB(property); break;
+    case GDK_CLIENT_EVENT:      FROB(client); break;
+    case GDK_MAP:
+    case GDK_UNMAP:            FROB(any); break;
+    case GDK_CONFIGURE:                FROB(configure); break;
+    case GDK_ENTER_NOTIFY:
+    case GDK_LEAVE_NOTIFY:      FROB(crossing); break;
+    case GDK_FOCUS_CHANGE:      FROB(focus_change); break;
+    case GDK_VISIBILITY_NOTIFY: FROB(visibility); break;
+    default:
+       ignore_p = TRUE;
+       /* Hrmm... do we really want to swallow all the other events as magic? */
+       *gdk_event_copy = *event;
+       break;
+    }
+#undef FROB
+
+    emacs_event->event_type = magic_event;
+    XSETFRAME (emacs_event->channel, frame);
+
+    if (ignore_p)
+    {
+       stderr_out ("Ignoring event... (%s)\n", event_name (event));
+       Fdeallocate_event (lisp_event);
+       return (FALSE);
+    }
+    else
+    {
+       enqueue_gtk_dispatch_event (lisp_event);
+       return (TRUE);
+    }
+}
+
+\f
+/************************************************************************/
+/*                      input pending / C-g checking                    */
+/************************************************************************/
+static void
+gtk_check_for_quit_char (struct device *d);
+
+static void
+check_for_tty_quit_char (struct device *d)
+{
+  SELECT_TYPE temp_mask;
+  int infd = DEVICE_INFD (d);
+  struct console *con = XCONSOLE (DEVICE_CONSOLE (d));
+  Emchar quit_char = CONSOLE_QUIT_CHAR (con);
+
+  FD_ZERO (&temp_mask);
+  FD_SET (infd, &temp_mask);
+
+  while (1)
+    {
+      Lisp_Object event;
+      Emchar the_char;
+
+      if (!poll_fds_for_input (temp_mask))
+       return;
+
+      event = Fmake_event (Qnil, Qnil);
+      if (!read_event_from_tty_or_stream_desc (XEVENT (event), con, infd))
+       /* EOF, or something ... */
+       return;
+      /* #### bogus.  quit-char should be allowed to be any sort
+        of event. */
+      the_char = event_to_character (XEVENT (event), 1, 0, 0);
+      if (the_char >= 0 && the_char == quit_char)
+       {
+         Vquit_flag = Qt;
+         /* do not queue the C-g.  See above. */
+         return;
+       }
+
+      /* queue the read event to be read for real later. */
+      enqueue_gtk_dispatch_event (event);
+    }
+}
+
+static void
+emacs_gtk_quit_p (void)
+{
+  Lisp_Object devcons, concons;
+
+  CONSOLE_LOOP (concons)
+    {
+      struct console *con = XCONSOLE (XCAR (concons));
+      if (!con->input_enabled)
+       continue;
+
+      CONSOLE_DEVICE_LOOP (devcons, con)
+       {
+         struct device *d;
+         d = XDEVICE (XCAR (devcons));
+
+         if (DEVICE_GTK_P (d))
+           /* emacs may be exiting */
+           gtk_check_for_quit_char (d);
+         else if (DEVICE_TTY_P (d))
+           check_for_tty_quit_char (d);
+       }
+    }
+}
+
+#include <gdk/gdkx.h>
+
+static void
+drain_gtk_queue (void)
+
+{
+  /* We can't just spin through here and wait for GTKs idea of the
+     event queue to get empty, or the queue never gets drained.  The
+     situation is as follows.  A process event gets signalled, we put
+     it on the queue, then we go into Fnext_event(), which calls
+     drain_gtk_queue().  But gtk_events_pending() will always return
+     TRUE if there are file-descriptor (aka our process) events
+     pending.  Using GDK_events_pending() only shows us windowing
+     system events.
+  */
+  if (GDK_DISPLAY ())
+    while (gdk_events_pending ())
+      gtk_main_iteration ();
+}
+
+static int
+emacs_gtk_event_pending_p (int user_p)
+{
+  Lisp_Object event;
+  int tick_count_val;
+
+  /* If `user_p' is false, then this function returns whether there are any
+     X, timeout, or fd events pending (that is, whether emacs_gtk_next_event()
+     would return immediately without blocking).
+
+     if `user_p' is true, then this function returns whether there are any
+     *user generated* events available (that is, whether there are keyboard
+     or mouse-click events ready to be read).  This also implies that
+     emacs_Xt_next_event() would not block.
+
+     In a non-SIGIO world, this also checks whether the user has typed ^G,
+     since this is a convenient place to do so.  We don't need to do this
+     in a SIGIO world, since input causes an interrupt.
+   */
+
+  /* This function used to simply check whether there were any X
+     events (or if user_p was 1, it iterated over all the pending
+     X events using XCheckIfEvent(), looking for keystrokes and
+     button events).  That worked in the old cheesoid event loop,
+     which didn't go through XtAppDispatchEvent(), but it doesn't
+     work any more -- X events may not result in anything.  For
+     example, a button press in a blank part of the menubar appears
+     as an X event but will not result in any Emacs events (a
+     button press that activates the menubar results in an Emacs
+     event through the stop_next_event mechanism).
+
+     The only accurate way of determining whether these X events
+     translate into Emacs events is to go ahead and dispatch them
+     until there's something on the dispatch queue. */
+
+  /* See if there are any user events already on the queue. */
+  EVENT_CHAIN_LOOP (event, dispatch_event_queue)
+    if (!user_p || command_event_p (event))
+      return 1;
+
+  /* See if there's any TTY input available.
+   */
+  if (poll_fds_for_input (tty_only_mask))
+    return 1;
+
+  if (!user_p)
+    {
+      /* If not user_p and there are any timer or file-desc events
+        pending, we know there will be an event so we're through. */
+/*      XtInputMask pending_value; */
+
+      /* Note that formerly we just checked the value of XtAppPending()
+        to determine if there was file-desc input.  This doesn't
+        work any more with the signal_event_pipe; XtAppPending()
+        will says "yes" in this case but there isn't really any
+        input.  Another way of fixing this problem is for the
+        signal_event_pipe to generate actual input in the form
+        of an identity eval event or something. (#### maybe this
+        actually happens?) */
+
+      if (poll_fds_for_input (process_only_mask))
+       return 1;
+
+      /* #### Is there any way to do this in Gtk?  I don't think there
+              is a 'peek' for events */
+#if 0
+      pending_value = XtAppPending (Xt_app_con);
+
+      if (pending_value & XtIMTimer)
+       return 1;
+#endif
+    }
+
+  /* XtAppPending() can be super-slow, esp. over a network connection.
+     Quantify results have indicated that in some cases the
+     call to detect_input_pending() completely dominates the
+     running time of redisplay().  Fortunately, in a SIGIO world
+     we can more quickly determine whether there are any X events:
+     if an event has happened since the last time we checked, then
+     a SIGIO will have happened.  On a machine with broken SIGIO,
+     we'll still be in an OK state -- the sigio_happened flag
+     will get set at least once a second, so we'll be no more than
+     one second behind reality. (In general it's OK if we
+     erroneously report no input pending when input is actually
+     pending() -- preemption is just a bit less efficient, that's
+     all.  It's bad bad bad if you err the other way -- you've
+     promised that `next-event' won't block but it actually will,
+     and some action might get delayed until the next time you
+     hit a key.)
+     */
+
+  /* quit_check_signal_tick_count is volatile so try to avoid race conditions
+     by using a temporary variable */
+  tick_count_val = quit_check_signal_tick_count;
+  if (last_quit_check_signal_tick_count != tick_count_val)
+    {
+      last_quit_check_signal_tick_count = tick_count_val;
+
+      /* We need to drain the entire queue now -- if we only
+         drain part of it, we may later on end up with events
+         actually pending but detect_input_pending() returning
+         false because there wasn't another SIGIO. */
+
+      drain_gtk_queue ();
+
+      EVENT_CHAIN_LOOP (event, dispatch_event_queue)
+        if (!user_p || command_event_p (event))
+          return 1;
+    }
+
+  return 0;
+}
+
+\f
+/************************************************************************/
+/*                            initialization                            */
+/************************************************************************/
+
+void
+syms_of_event_gtk (void)
+{
+  defsymbol (&Qkey_mapping, "key-mapping");
+  defsymbol (&Qsans_modifiers, "sans-modifiers");
+}
+
+void reinit_vars_of_event_gtk (void)
+{
+  gtk_event_stream = xnew (struct event_stream);
+  gtk_event_stream->event_pending_p    = emacs_gtk_event_pending_p;
+  gtk_event_stream->next_event_cb      = emacs_gtk_next_event;
+  gtk_event_stream->handle_magic_event_cb= emacs_gtk_handle_magic_event;
+  gtk_event_stream->add_timeout_cb     = emacs_gtk_add_timeout;
+  gtk_event_stream->remove_timeout_cb  = emacs_gtk_remove_timeout;
+  gtk_event_stream->select_console_cb  = emacs_gtk_select_console;
+  gtk_event_stream->unselect_console_cb = emacs_gtk_unselect_console;
+  gtk_event_stream->select_process_cb  = emacs_gtk_select_process;
+  gtk_event_stream->unselect_process_cb = emacs_gtk_unselect_process;
+  gtk_event_stream->quit_p_cb          = emacs_gtk_quit_p;
+  gtk_event_stream->create_stream_pair_cb= emacs_gtk_create_stream_pair;
+  gtk_event_stream->delete_stream_pair_cb= emacs_gtk_delete_stream_pair;
+
+  the_GTK_timeout_blocktype = Blocktype_new (struct GTK_timeout_blocktype);
+
+  /* this function only makes safe calls */
+  init_what_input_once ();
+}
+
+void
+vars_of_event_gtk (void)
+{
+  reinit_vars_of_event_gtk ();
+
+  dispatch_event_queue = Qnil;
+  staticpro (&dispatch_event_queue);
+  dispatch_event_queue_tail = Qnil;
+
+  DEFVAR_BOOL ("gtk-allow-sendevents", &gtk_allow_sendevents /*
+*Non-nil means to allow synthetic events.  Nil means they are ignored.
+Beware: allowing emacs to process SendEvents opens a big security hole.
+*/ );
+  gtk_allow_sendevents = 0;
+
+  last_quit_check_signal_tick_count = 0;
+}
+
+void
+init_event_gtk_late (void) /* called when already initialized */
+{
+  timeout_id_tick = 1;
+  pending_timeouts = 0;
+  completed_timeouts = 0;
+
+  event_stream = gtk_event_stream;
+
+#if 0
+  /* Shut GDK the hell up */
+  gdk_error_trap_push ();
+#endif
+
+  gdk_input_add (signal_event_pipe[0], GDK_INPUT_READ,
+                (GdkInputFunction) gtk_what_callback, NULL);
+}
+
+/* Bogus utility routines */
+static const char *event_name (GdkEvent *ev)
+{
+  return (gtk_event_name (ev->any.type));
+}
+
+/* This is down at the bottom of the file so I can avoid polluting the
+   generic code with this X specific CRAP! */
+
+#include <gdk/gdkx.h>
+#include <X11/keysym.h>
+/* #### BILL!!! Fix this please! */
+
+\f
+/************************************************************************/
+/*                            keymap handling                           */
+/************************************************************************/
+
+/* X bogusly doesn't define the interpretations of any bits besides
+   ModControl, ModShift, and ModLock; so the Interclient Communication
+   Conventions Manual says that we have to bend over backwards to figure
+   out what the other modifier bits mean.  According to ICCCM:
+
+   - Any keycode which is assigned ModControl is a "control" key.
+
+   - Any modifier bit which is assigned to a keycode which generates Meta_L
+     or Meta_R is the modifier bit meaning "meta".  Likewise for Super, Hyper,
+     etc.
+
+   - Any keypress event which contains ModControl in its state should be
+     interpreted as a "control" character.
+
+   - Any keypress event which contains a modifier bit in its state which is
+     generated by a keycode whose corresponding keysym is Meta_L or Meta_R
+     should be interpreted as a "meta" character.  Likewise for Super, Hyper,
+     etc.
+
+   - It is illegal for a keysym to be associated with more than one modifier
+     bit.
+
+   This means that the only thing that emacs can reasonably interpret as a
+   "meta" key is a key whose keysym is Meta_L or Meta_R, and which generates
+   one of the modifier bits Mod1-Mod5.
+
+   Unfortunately, many keyboards don't have Meta keys in their default
+   configuration.  So, if there are no Meta keys, but there are "Alt" keys,
+   emacs will interpret Alt as Meta.  If there are both Meta and Alt keys,
+   then the Meta keys mean "Meta", and the Alt keys mean "Alt" (it used to
+   mean "Symbol," but that just confused the hell out of way too many people).
+
+   This works with the default configurations of the 19 keyboard-types I've
+   checked.
+
+   Emacs detects keyboard configurations which violate the above rules, and
+   prints an error message on the standard-error-output.  (Perhaps it should
+   use a pop-up-window instead.)
+ */
+
+static void
+gtk_reset_key_mapping (struct device *d)
+{
+  Display *display = GDK_DISPLAY ();
+  struct gtk_device *xd = DEVICE_GTK_DATA (d);
+  XModifierKeymap *map = (XModifierKeymap *) xd->x_keysym_map;
+  KeySym *keysym, *keysym_end;
+  Lisp_Object hashtable;
+  int key_code_count, keysyms_per_code;
+
+  if (map)
+    XFree ((char *) map);
+  XDisplayKeycodes (display,
+                   &xd->x_keysym_map_min_code,
+                   &xd->x_keysym_map_max_code);
+  key_code_count = xd->x_keysym_map_max_code - xd->x_keysym_map_min_code + 1;
+  map = (XModifierKeymap *)
+    XGetKeyboardMapping (display, xd->x_keysym_map_min_code, key_code_count,
+                        &xd->x_keysym_map_keysyms_per_code);
+
+  xd->x_keysym_map = (void *)map;
+  hashtable = xd->x_keysym_map_hashtable;
+  if (HASH_TABLEP (hashtable))
+    {
+      Fclrhash (hashtable);
+    }
+  else
+    {
+      xd->x_keysym_map_hashtable = hashtable =
+       make_lisp_hash_table (128, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
+    }
+
+  for (keysym = (KeySym *) map,
+        keysyms_per_code = xd->x_keysym_map_keysyms_per_code,
+        keysym_end = keysym + (key_code_count * keysyms_per_code);
+       keysym < keysym_end;
+       keysym += keysyms_per_code)
+    {
+      int j;
+
+      if (keysym[0] == NoSymbol)
+       continue;
+
+      {
+       char *name = XKeysymToString (keysym[0]);
+       Lisp_Object sym = gtk_keysym_to_emacs_keysym (keysym[0], 0);
+       if (name)
+         {
+           Fputhash (build_string (name), Qsans_modifiers, hashtable);
+           Fputhash (sym, Qsans_modifiers, hashtable);
+         }
+      }
+
+      for (j = 1; j < keysyms_per_code; j++)
+       {
+         if (keysym[j] != keysym[0] &&
+             keysym[j] != NoSymbol)
+           {
+             char *name = XKeysymToString (keysym[j]);
+             Lisp_Object sym = gtk_keysym_to_emacs_keysym (keysym[j], 0);
+             if (name && NILP (Fgethash (sym, hashtable, Qnil)))
+               {
+                 Fputhash (build_string (name), Qt, hashtable);
+                 Fputhash (sym, Qt, hashtable);
+               }
+           }
+       }
+    }
+}
+
+static const char *
+index_to_name (int indice)
+{
+  switch (indice)
+    {
+    case ShiftMapIndex:   return "ModShift";
+    case LockMapIndex:    return "ModLock";
+    case ControlMapIndex: return "ModControl";
+    case Mod1MapIndex:    return "Mod1";
+    case Mod2MapIndex:    return "Mod2";
+    case Mod3MapIndex:    return "Mod3";
+    case Mod4MapIndex:    return "Mod4";
+    case Mod5MapIndex:    return "Mod5";
+    default:              return "???";
+    }
+}
+
+/* Boy, I really wish C had local functions... */
+struct c_doesnt_have_closures   /* #### not yet used */
+{
+  int warned_about_overlapping_modifiers;
+  int warned_about_predefined_modifiers;
+  int warned_about_duplicate_modifiers;
+  int meta_bit;
+  int hyper_bit;
+  int super_bit;
+  int alt_bit;
+  int mode_bit;
+};
+
+static void
+gtk_reset_modifier_mapping (struct device *d)
+{
+  Display *display = GDK_DISPLAY ();
+  struct gtk_device *xd = DEVICE_GTK_DATA (d);
+  int modifier_index, modifier_key, column, mkpm;
+  int warned_about_overlapping_modifiers = 0;
+  /*  int warned_about_predefined_modifiers  = 0; */
+  /* int warned_about_duplicate_modifiers   = 0; */
+  int meta_bit  = 0;
+  int hyper_bit = 0;
+  int super_bit = 0;
+  int alt_bit   = 0;
+  int mode_bit  = 0;
+  XModifierKeymap *map = (XModifierKeymap *) xd->x_modifier_keymap;
+
+  xd->lock_interpretation = 0;
+
+  if (map)
+    XFreeModifiermap (map);
+
+  gtk_reset_key_mapping (d);
+
+  xd->x_modifier_keymap = map = XGetModifierMapping (display);
+
+  /* Boy, I really wish C had local functions...
+   */
+
+  /* The call to warn_when_safe must be on the same line as the string or
+     make-msgfile won't pick it up properly (the newline doesn't confuse
+     it, but the backslash does). */
+
+#define store_modifier(name,old)                                          \
+    old = modifier_index;
+
+  mkpm = map->max_keypermod;
+  for (modifier_index = 0; modifier_index < 8; modifier_index++)
+    for (modifier_key = 0; modifier_key < mkpm; modifier_key++) {
+      KeySym last_sym = 0;
+      for (column = 0; column < 4; column += 2) {
+       KeyCode code = map->modifiermap[modifier_index * mkpm
+                                                         + modifier_key];
+       KeySym sym = (code ? XKeycodeToKeysym (display, code, column) : 0);
+       if (sym == last_sym) continue;
+       last_sym = sym;
+       switch (sym) {
+       case XK_Mode_switch:store_modifier ("Mode_switch", mode_bit); break;
+       case XK_Meta_L:     store_modifier ("Meta_L", meta_bit); break;
+       case XK_Meta_R:     store_modifier ("Meta_R", meta_bit); break;
+       case XK_Super_L:    store_modifier ("Super_L", super_bit); break;
+       case XK_Super_R:    store_modifier ("Super_R", super_bit); break;
+       case XK_Hyper_L:    store_modifier ("Hyper_L", hyper_bit); break;
+       case XK_Hyper_R:    store_modifier ("Hyper_R", hyper_bit); break;
+       case XK_Alt_L:      store_modifier ("Alt_L", alt_bit); break;
+       case XK_Alt_R:      store_modifier ("Alt_R", alt_bit); break;
+#if 0
+       case XK_Control_L:  check_modifier ("Control_L", ControlMask); break;
+       case XK_Control_R:  check_modifier ("Control_R", ControlMask); break;
+       case XK_Shift_L:    check_modifier ("Shift_L", ShiftMask); break;
+       case XK_Shift_R:    check_modifier ("Shift_R", ShiftMask); break;
+#endif
+       case XK_Shift_Lock: /* check_modifier ("Shift_Lock", LockMask); */
+         xd->lock_interpretation = XK_Shift_Lock; break;
+       case XK_Caps_Lock:  /* check_modifier ("Caps_Lock", LockMask); */
+         xd->lock_interpretation = XK_Caps_Lock; break;
+
+       /* It probably doesn't make any sense for a modifier bit to be
+          assigned to a key that is not one of the above, but OpenWindows
+          assigns modifier bits to a couple of random function keys for
+          no reason that I can discern, so printing a warning here would
+          be annoying. */
+       }
+      }
+    }
+#undef store_modifier
+#undef check_modifier
+#undef modwarn
+#undef modbarf
+
+  /* If there was no Meta key, then try using the Alt key instead.
+     If there is both a Meta key and an Alt key, then the Alt key
+     is not disturbed and remains an Alt key. */
+  if (! meta_bit && alt_bit)
+    meta_bit = alt_bit, alt_bit = 0;
+
+  /* mode_bit overrides everything, since it's processed down inside of
+     XLookupString() instead of by us.  If Meta and Mode_switch both
+     generate the same modifier bit (which is an error), then we don't
+     interpret that bit as Meta, because we can't make XLookupString()
+     not interpret it as Mode_switch; and interpreting it as both would
+     be totally wrong. */
+  if (mode_bit)
+    {
+      const char *warn = 0;
+      if      (mode_bit == meta_bit)  warn = "Meta",  meta_bit  = 0;
+      else if (mode_bit == hyper_bit) warn = "Hyper", hyper_bit = 0;
+      else if (mode_bit == super_bit) warn = "Super", super_bit = 0;
+      else if (mode_bit == alt_bit)   warn = "Alt",   alt_bit   = 0;
+      if (warn)
+       {
+         warn_when_safe
+           (Qkey_mapping, Qwarning,
+            "XEmacs:  %s is being used for both Mode_switch and %s.",
+            index_to_name (mode_bit), warn),
+           warned_about_overlapping_modifiers = 1;
+       }
+    }
+#undef index_to_name
+
+  xd->MetaMask   = (meta_bit   ? (1 << meta_bit)  : 0);
+  xd->HyperMask  = (hyper_bit  ? (1 << hyper_bit) : 0);
+  xd->SuperMask  = (super_bit  ? (1 << super_bit) : 0);
+  xd->AltMask    = (alt_bit    ? (1 << alt_bit)   : 0);
+  xd->ModeMask   = (mode_bit   ? (1 << mode_bit)  : 0); /* unused */
+
+}
+
+void
+gtk_init_modifier_mapping (struct device *d)
+{
+  struct gtk_device *gd = DEVICE_GTK_DATA (d);
+  gd->x_keysym_map_hashtable = Qnil;
+  gd->x_keysym_map = NULL;
+  gd->x_modifier_keymap = NULL;
+  gtk_reset_modifier_mapping (d);
+}
+
+#if 0
+static int
+gtk_key_is_modifier_p (KeyCode keycode, struct device *d)
+{
+  struct gtk_device *xd = DEVICE_GTK_DATA (d);
+  KeySym *syms;
+  KeySym *map = (KeySym *) xd->x_keysym_map;
+  int i;
+
+  if (keycode < xd->x_keysym_map_min_code ||
+      keycode > xd->x_keysym_map_max_code)
+    return 0;
+
+  syms = &map [(keycode - xd->x_keysym_map_min_code) *
+             xd->x_keysym_map_keysyms_per_code];
+  for (i = 0; i < xd->x_keysym_map_keysyms_per_code; i++)
+    if (IsModifierKey (syms [i]) ||
+       syms [i] == XK_Mode_switch) /* why doesn't IsModifierKey count this? */
+      return 1;
+  return 0;
+}
+#endif
+
+struct _quit_predicate_closure {
+  struct device *device;
+  Bool *critical;
+};
+
+static Bool
+quit_char_predicate (Display *display, XEvent *event, XPointer data)
+{
+  struct _quit_predicate_closure *cl = (struct _quit_predicate_closure *) data;
+  struct device *d = cl->device;
+  struct frame *f = NULL;
+  struct gtk_device *gd = DEVICE_GTK_DATA (d);
+  char c, quit_char;
+  Bool *critical = cl->critical;
+  Lisp_Object keysym;
+  GdkWindow *window = gdk_window_lookup (event->xany.window);
+  guint32 keycode = 0;
+  GdkEventKey gdk_event;
+
+  if (window)
+    f = gtk_any_window_to_frame (d, window);
+
+  if (critical)
+    *critical = False;
+
+  if ((event->type != KeyPress) ||
+      (! window) ||
+      (! f) ||
+      (event->xkey.state
+       & (gd->MetaMask | gd->HyperMask | gd->SuperMask | gd->AltMask)))
+    {
+      return 0;
+    }
+
+  {
+    char dummy[256];
+    XLookupString (&(event->xkey), dummy, 200, (KeySym *)&keycode, 0);
+  }
+
+  memset (&gdk_event, 0, sizeof (gdk_event));
+  gdk_event.type = GDK_KEY_PRESS;
+  gdk_event.window = window;
+  gdk_event.keyval = keycode;
+  gdk_event.state = event->xkey.state;
+
+  /* This duplicates some code that exists elsewhere, but it's relatively
+     fast and doesn't cons. */
+  keysym = gtk_to_emacs_keysym (d, &gdk_event, 1);
+  if (NILP (keysym)) return 0;
+  if (CHAR_OR_CHAR_INTP (keysym))
+    c = XCHAR_OR_CHAR_INT (keysym);
+  /* Highly doubtful that these are the quit character, but... */
+  else if (EQ (keysym, QKbackspace))   c = '\b';
+  else if (EQ (keysym, QKtab))         c = '\t';
+  else if (EQ (keysym, QKlinefeed))    c = '\n';
+  else if (EQ (keysym, QKreturn))      c = '\r';
+  else if (EQ (keysym, QKescape))      c = 27;
+  else if (EQ (keysym, QKspace))       c = ' ';
+  else if (EQ (keysym, QKdelete))      c = 127;
+  else return 0;
+
+  if (event->xkey.state & gd->MetaMask)     c |= 0x80;
+  if ((event->xkey.state & ControlMask) && !(c >= 'A' && c <= 'Z'))
+    c &= 0x1F;                 /* unshifted control characters */
+  quit_char = CONSOLE_QUIT_CHAR (XCONSOLE (DEVICE_CONSOLE (d)));
+
+  if (c == quit_char)
+    return True;
+  /* If we've got Control-Shift-G instead of Control-G, that means
+     we have a critical_quit.  Caps_Lock is its own modifier, so it
+     won't cause ^G to act differently than before. */
+  if (event->xkey.state & ControlMask)  c &= 0x1F;
+  if (c == quit_char)
+    {
+      if (critical) *critical = True;
+      return True;
+    }
+  return False;
+}
+
+static void
+gtk_check_for_quit_char (struct device *d)
+{
+  XEvent event;
+  int queued;
+  Bool critical_quit = False;
+  struct _quit_predicate_closure closure;
+
+  XEventsQueued (GDK_DISPLAY (), QueuedAfterReading);
+
+  closure.device = d;
+  closure.critical = &critical_quit;
+
+  queued = XCheckIfEvent (GDK_DISPLAY (), &event, quit_char_predicate, (char *) &closure);
+
+  if (queued)
+    {
+      Vquit_flag = (critical_quit ? Qcritical : Qt);
+    }
+}

diff --git a/src/frame-gtk.c b/src/frame-gtk.c
new file mode 100644 (file)
index 0000000..963d259
--- /dev/null
+++ b/src/frame-gtk.c
@@ -0,0 +1,1498 @@
+/* Functions for the X window system.
+   Copyright (C) 1989, 1992-5, 1997 Free Software Foundation, Inc.
+   Copyright (C) 1995, 1996 Ben Wing.
+
+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, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with: Not synched with FSF. */
+
+/* Substantially rewritten for XEmacs.  */
+/* Revamped to use Gdk/Gtk by William Perry */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "console-gtk.h"
+#include "ui-gtk.h"
+#include "glyphs-gtk.h"
+#include "objects-gtk.h"
+#include "scrollbar-gtk.h"
+
+#include "gtk-xemacs.h"
+
+#include "buffer.h"
+#include "events.h"
+#include "extents.h"
+#include "faces.h"
+#include "frame.h"
+#include "window.h"
+
+#ifdef HAVE_GNOME
+#include <libgnomeui/libgnomeui.h>
+#endif
+
+#ifdef HAVE_DRAGNDROP
+#include "dragdrop.h"
+#endif
+
+#define BORDER_WIDTH 0
+#define INTERNAL_BORDER_WIDTH 0
+
+#define TRANSIENT_DATA_IDENTIFIER "xemacs::transient_for"
+#define FRAME_DATA_IDENTIFIER "xemacs::frame"
+#define UNMAPPED_DATA_IDENTIFIER "xemacs::initially_unmapped"
+
+#define STUPID_X_SPECIFIC_GTK_STUFF
+
+#ifdef STUPID_X_SPECIFIC_GTK_STUFF
+#include <gdk/gdkx.h>
+#endif
+
+/* Default properties to use when creating frames.  */
+Lisp_Object Vdefault_gtk_frame_plist;
+
+Lisp_Object Qwindow_id;
+Lisp_Object Qdetachable_menubar;
+Lisp_Object Qtext_widget;
+Lisp_Object Qcontainer_widget;
+Lisp_Object Qshell_widget;
+
+#ifdef STUPID_X_SPECIFIC_GTK_STUFF
+EXFUN (Fgtk_window_id, 1);
+#endif
+
+#ifdef HAVE_DRAGNDROP
+enum {
+  TARGET_TYPE_STRING,
+  TARGET_TYPE_URI_LIST,
+};
+
+static GtkTargetEntry dnd_target_table[] = {
+  { "STRING",     0, TARGET_TYPE_STRING },
+  { "text/plain", 0, TARGET_TYPE_STRING },
+  { "text/uri-list", 0, TARGET_TYPE_URI_LIST },
+  { "_NETSCAPE_URL", 0, TARGET_TYPE_STRING }
+};
+
+static guint dnd_n_targets = sizeof(dnd_target_table) / sizeof(dnd_target_table[0]);
+
+#endif
+
+\f
+/************************************************************************/
+/*                          helper functions                            */
+/************************************************************************/
+
+/* Return the Emacs frame-object corresponding to an X window */
+struct frame *
+gtk_window_to_frame (struct device *d, GdkWindow *wdesc)
+{
+  Lisp_Object tail, frame;
+  struct frame *f;
+
+  /* This function was previously written to accept only a window argument
+     (and to loop over all devices looking for a matching window), but
+     that is incorrect because window ID's are not unique across displays. */
+
+  for (tail = DEVICE_FRAME_LIST (d); CONSP (tail); tail = XCDR (tail))
+    {
+      frame = XCAR (tail);
+      if (!FRAMEP (frame))
+       continue;
+      f = XFRAME (frame);
+      if (FRAME_GTK_P (f) && GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (f)) == wdesc)
+       return f;
+    }
+  return 0;
+}
+
+/* Like gtk_window_to_frame but also compares the window with the widget's
+   windows */
+struct frame *
+gtk_any_window_to_frame (struct device *d, GdkWindow *w)
+{
+    do
+    {
+       Lisp_Object frmcons;
+
+       DEVICE_FRAME_LOOP (frmcons, d)
+           {
+               struct frame *fr = XFRAME (XCAR (frmcons));
+               if ((w == GET_GTK_WIDGET_WINDOW (FRAME_GTK_SHELL_WIDGET (fr))) ||
+                   (w == GET_GTK_WIDGET_WINDOW (FRAME_GTK_CONTAINER_WIDGET (fr))) ||
+#ifdef HAVE_MENUBARS
+                   (w == GET_GTK_WIDGET_WINDOW (FRAME_GTK_MENUBAR_WIDGET (fr))) ||
+#endif
+                   (w == GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (fr))))
+               {
+                   return (fr);
+               }
+           }
+       w = gdk_window_get_parent (w);
+    } while (w);
+
+    return (0);
+}
+
+struct frame *
+gtk_any_widget_or_parent_to_frame (struct device *d, GtkWidget *widget)
+{
+    return (gtk_any_window_to_frame (d, GET_GTK_WIDGET_WINDOW (widget)));
+}
+
+struct device *
+gtk_any_window_to_device (GdkWindow *w)
+{
+       struct device *d = NULL;
+       Lisp_Object devcons, concons;
+
+       DEVICE_LOOP_NO_BREAK (devcons, concons)
+               {
+                       d = XDEVICE (XCAR (devcons));
+                       if (!DEVICE_GTK_P (d)) continue;
+                       if (gtk_any_window_to_frame (d, w))
+                               return (d);
+               }
+       return (NULL);
+}
+
+struct frame *
+decode_gtk_frame (Lisp_Object frame)
+{
+  if (NILP (frame))
+    XSETFRAME (frame, selected_frame ());
+  CHECK_LIVE_FRAME (frame);
+  /* this will also catch dead frames, but putting in the above check
+     results in a more useful error */
+  CHECK_GTK_FRAME (frame);
+  return XFRAME (frame);
+}
+
+\f
+/************************************************************************/
+/*                     window-manager interactions                     */
+/************************************************************************/
+static int
+gtk_frame_iconified_p (struct frame *f)
+{
+    return (f->iconified);
+}
+
+\f
+/************************************************************************/
+/*                          frame properties                            */
+/************************************************************************/
+
+static Lisp_Object
+gtk_frame_property (struct frame *f, Lisp_Object property)
+{
+  GtkWidget *shell = FRAME_GTK_SHELL_WIDGET (f);
+
+  if (EQ (Qleft, property) || EQ (Qtop, property))
+    {
+      gint x, y;
+      if (!GET_GTK_WIDGET_WINDOW(shell))
+       return Qzero;
+      gdk_window_get_deskrelative_origin (GET_GTK_WIDGET_WINDOW (shell), &x, &y);
+      if (EQ (Qleft, property)) return make_int (x);
+      if (EQ (Qtop,  property)) return make_int (y);
+    }
+  if (EQ (Qshell_widget, property))
+    {
+      return (FRAME_GTK_LISP_WIDGETS (f)[0]);
+    }
+  if (EQ (Qcontainer_widget, property))
+    {
+      return (FRAME_GTK_LISP_WIDGETS (f)[1]);
+    }
+  if (EQ (Qtext_widget, property))
+    {
+      return (FRAME_GTK_LISP_WIDGETS (f)[2]);
+    }
+#ifdef STUPID_X_SPECIFIC_GTK_STUFF
+  if (EQ (Qwindow_id, property))
+    return Fgtk_window_id (make_frame (f));
+#endif
+
+  return Qunbound;
+}
+
+static int
+gtk_internal_frame_property_p (struct frame *f, Lisp_Object property)
+{
+  return EQ (property, Qleft)
+    || EQ (property, Qtop)
+    || EQ (Qshell_widget, property)
+    || EQ (Qcontainer_widget, property)
+    || EQ (Qtext_widget, property)
+    || EQ (property, Qwindow_id)
+    || STRINGP (property);
+}
+
+static Lisp_Object
+gtk_frame_properties (struct frame *f)
+{
+  Lisp_Object props = Qnil;
+  GtkWidget *shell = FRAME_GTK_SHELL_WIDGET (f);
+  gint x, y;
+
+  props = cons3 (Qshell_widget, FRAME_GTK_LISP_WIDGETS (f)[0], props);
+  props = cons3 (Qcontainer_widget, FRAME_GTK_LISP_WIDGETS (f)[1], props);
+  props = cons3 (Qtext_widget, FRAME_GTK_LISP_WIDGETS (f)[2], props);
+
+#ifdef STUPID_X_SPECIFIC_GTK_STUFF
+  props = cons3 (Qwindow_id, Fgtk_window_id (make_frame (f)), props);
+#endif
+
+  if (!GET_GTK_WIDGET_WINDOW (shell))
+    x = y = 0;
+  else
+    gdk_window_get_deskrelative_origin (GET_GTK_WIDGET_WINDOW (shell), &x, &y);
+
+  props = cons3 (Qtop,  make_int (y), props);
+  props = cons3 (Qleft, make_int (x), props);
+
+  return props;
+}
+
+\f
+/* Functions called only from `gtk_set_frame_properties' to set
+   individual properties. */
+
+static void
+gtk_set_frame_text_value (struct frame *f, Bufbyte *value,
+                         void (*func) (gpointer, gchar *),
+                         gpointer arg)
+{
+  gchar *the_text = (gchar *) value;
+
+  /* Programmer fuckup or window is not realized yet. */
+  if (!func || !arg) return;
+
+#ifdef MULE
+  {
+    Bufbyte *ptr;
+    
+    /* Optimize for common ASCII case */
+    for (ptr = value; *ptr; ptr++)
+      if (!BYTE_ASCII_P (*ptr))
+       {
+         char *tmp;
+         C_STRING_TO_EXTERNAL (value, tmp, Qctext);
+         the_text = tmp;
+         break;
+       }
+  }
+#endif /* MULE */
+
+  (*func) (arg, (gchar *) the_text);
+}
+
+static void
+gtk_set_title_from_bufbyte (struct frame *f, Bufbyte *name)
+{
+  if (GTK_IS_WINDOW (FRAME_GTK_SHELL_WIDGET (f)))
+    gtk_set_frame_text_value (f, name,
+                             (void (*)(gpointer, gchar *))
+                             gtk_window_set_title, FRAME_GTK_SHELL_WIDGET (f));
+}
+
+static void
+gtk_set_icon_name_from_bufbyte (struct frame *f, Bufbyte *name)
+{
+  gtk_set_frame_text_value (f, name,
+                           (void (*)(gpointer, gchar *))
+                           gdk_window_set_icon_name, FRAME_GTK_SHELL_WIDGET (f)->window);
+}
+
+/* Set the initial frame size as specified.  This function is used
+   when the frame's widgets have not yet been realized.
+*/
+static void
+gtk_set_initial_frame_size (struct frame *f, int x, int y,
+                           unsigned int w, unsigned int h)
+{
+  GtkWidget *shell = FRAME_GTK_SHELL_WIDGET (f);
+  GdkGeometry geometry;
+  GdkWindowHints geometry_mask = 0x00;
+
+  if (GTK_IS_WINDOW (shell))
+    {
+      /* Deal with the cell size */
+      default_face_height_and_width (make_frame (f), &geometry.height_inc, &geometry.width_inc);
+      geometry_mask |= GDK_HINT_RESIZE_INC;
+
+      gtk_window_set_geometry_hints (GTK_WINDOW (shell),
+                                    FRAME_GTK_TEXT_WIDGET (f), &geometry, geometry_mask);
+      gdk_window_set_hints (GET_GTK_WIDGET_WINDOW (shell), x, y, 0, 0, 0, 0, GDK_HINT_POS);
+      gtk_window_set_policy (GTK_WINDOW (shell), TRUE, TRUE, FALSE);
+    }
+
+  FRAME_HEIGHT (f) = h;
+  FRAME_WIDTH (f) = w;
+
+  change_frame_size (f, h, w, 0);
+  {
+    GtkRequisition req;
+ 
+    gtk_widget_size_request (FRAME_GTK_SHELL_WIDGET (f), &req);
+    gtk_widget_set_usize (FRAME_GTK_SHELL_WIDGET (f), req.width, req.height);
+  }
+}
+
+/* Report that a frame property of frame S is being set or changed.
+   If the property is not specially recognized, do nothing.
+ */
+
+static void
+gtk_set_frame_properties (struct frame *f, Lisp_Object plist)
+{
+  gint x, y;
+  gint width = 0, height = 0;
+  gboolean width_specified_p = FALSE;
+  gboolean height_specified_p = FALSE;
+  gboolean x_position_specified_p = FALSE;
+  gboolean y_position_specified_p = FALSE;
+  Lisp_Object tail;
+
+  for (tail = plist; !NILP (tail); tail = Fcdr (Fcdr (tail)))
+    {
+      Lisp_Object prop = Fcar (tail);
+      Lisp_Object val = Fcar (Fcdr (tail));
+
+      if (SYMBOLP (prop))
+       {
+         if (EQ (prop, Qfont))
+         {
+             /* If the value is not a string we silently ignore it. */
+             if (STRINGP (val))
+             {
+                 Lisp_Object frm, font_spec;
+
+                 XSETFRAME (frm, f);
+                 font_spec = Fget (Fget_face (Qdefault), Qfont, Qnil);
+
+                 Fadd_spec_to_specifier (font_spec, val, frm, Qnil, Qnil);
+                 update_frame_face_values (f);
+             }
+             continue;
+         }
+         else if (EQ (prop, Qwidth))
+         {
+             CHECK_INT (val);
+             width = XINT (val);
+             width_specified_p = TRUE;
+             continue;
+         }
+         else if (EQ (prop, Qheight))
+         {
+             CHECK_INT (val);
+             height = XINT (val);
+             height_specified_p = TRUE;
+             continue;
+         }
+         /* Further kludge the x/y. */
+         else if (EQ (prop, Qx))
+         {
+             CHECK_INT (val);
+             x = (gint) XINT (val);
+             x_position_specified_p = TRUE;
+             continue;
+         }
+         else if (EQ (prop, Qy))
+         {
+             CHECK_INT (val);
+             y = (gint) XINT (val);
+             y_position_specified_p = TRUE;
+             continue;
+         }
+       }
+    }
+
+  /* Kludge kludge kludge.   We need to deal with the size and position
+   specially. */
+  {
+    int size_specified_p = width_specified_p || height_specified_p;
+    int position_specified_p = x_position_specified_p || y_position_specified_p;
+
+    if (!width_specified_p)
+      width = 80;
+    if (!height_specified_p)
+      height = 30;
+
+    /* Kludge kludge kludge kludge. */
+    if (position_specified_p &&
+       (!x_position_specified_p || !y_position_specified_p))
+      {
+       gint dummy;
+       GtkWidget *shell = FRAME_GTK_SHELL_WIDGET (f);
+       gdk_window_get_deskrelative_origin (GET_GTK_WIDGET_WINDOW (shell),
+                                           (x_position_specified_p ? &dummy : &x),
+                                           (y_position_specified_p ? &dummy : &y));
+      }
+
+    if (!f->init_finished)
+      {
+       if (size_specified_p || position_specified_p)
+         gtk_set_initial_frame_size (f, x, y, width, height);
+      }
+    else
+      {
+       if (size_specified_p)
+         {
+           Lisp_Object frame;
+           XSETFRAME (frame, f);
+           Fset_frame_size (frame, make_int (width), make_int (height), Qnil);
+         }
+       if (position_specified_p)
+         {
+           Lisp_Object frame;
+           XSETFRAME (frame, f);
+           Fset_frame_position (frame, make_int (x), make_int (y));
+         }
+      }
+  }
+}
+
+\f
+/************************************************************************/
+/*                             widget creation                         */
+/************************************************************************/
+/* Figure out what size the shell widget should initially be,
+   and set it.  Should be called after the default font has been
+   determined but before the widget has been realized. */
+
+extern Lisp_Object Vgtk_initial_geometry;
+
+#ifndef HAVE_GNOME
+static int
+get_number (const char **geometry)
+{
+  int value = 0;
+  int mult  = 1;
+       
+  if (**geometry == '-'){
+    mult = -1;
+    (*geometry)++;
+  }
+  while (**geometry && isdigit (**geometry)){
+    value = value * 10 + (**geometry - '0');
+    (*geometry)++;
+  }
+  return value * mult;
+}
+
+/*
+ */
+
+/**
+ * gnome_parse_geometry
+ * @geometry: geometry string to be parsed
+ * @xpos: X position geometry component
+ * @ypos: Y position geometry component
+ * @width: pixel width geometry component
+ * @height: pixel height geometry component
+ *
+ * Description:
+ * Parses the geometry string passed in @geometry, and fills
+ * @xpos, @ypos, @width, and @height with
+ * the corresponding values upon completion of the parse.
+ * If the parse fails, it should be assumed that @xpos, @ypos, @width,
+ * and @height contain undefined values.
+ *
+ * Returns:
+ * %TRUE if the geometry was successfully parsed, %FALSE otherwise.
+ **/
+
+static gboolean
+gnome_parse_geometry (const gchar *geometry, gint *xpos, 
+                     gint *ypos, gint *width, gint *height)
+{
+  int subtract;
+
+  g_return_val_if_fail (xpos != NULL, FALSE);
+  g_return_val_if_fail (ypos != NULL, FALSE);
+  g_return_val_if_fail (width != NULL, FALSE);
+  g_return_val_if_fail (height != NULL, FALSE);
+       
+  *xpos = *ypos = *width = *height = -1;
+
+  if (!geometry)
+    return FALSE;
+
+  if (*geometry == '=')
+    geometry++;
+  if (!*geometry)
+    return FALSE;
+  if (isdigit (*geometry))
+    *width = get_number (&geometry);
+  if (!*geometry)
+    return TRUE;
+  if (*geometry == 'x' || *geometry == 'X'){
+    geometry++;
+    *height = get_number (&geometry);
+  }
+  if (!*geometry)
+    return 1;
+  if (*geometry == '+'){
+    subtract = 0;
+    geometry++;
+  } else if (*geometry == '-'){
+    subtract = gdk_screen_width ();
+    geometry++;
+  } else
+    return FALSE;
+  *xpos = get_number (&geometry);
+  if (subtract)
+    *xpos = subtract - *xpos;
+  if (!*geometry)
+    return TRUE;
+  if (*geometry == '+'){
+    subtract = 0;
+    geometry++;
+  } else if (*geometry == '-'){
+    subtract = gdk_screen_height ();
+    geometry++;
+  } else
+    return FALSE;
+  *ypos = get_number (&geometry);
+  if (subtract)
+    *ypos = subtract - *ypos;
+  return TRUE;
+}
+#endif
+
+static void
+gtk_initialize_frame_size (struct frame *f)
+{
+  gint x = 10, y = 10, w = 80, h = 30;
+
+  if (STRINGP (Vgtk_initial_geometry))
+    {
+      if (!gnome_parse_geometry (XSTRING_DATA (Vgtk_initial_geometry), &x,&y,&w,&h))
+       {
+         x = y = 10;
+         w = 80;
+         h = 30;
+       }
+    }
+
+  /* set the position of the frame's root window now.  When the
+     frame was created, the position was initialized to (0,0). */
+  {
+    struct window *win = XWINDOW (f->root_window);
+
+    WINDOW_LEFT (win) = FRAME_LEFT_BORDER_END (f);
+    WINDOW_TOP (win) = FRAME_TOP_BORDER_END (f);
+
+    if (!NILP (f->minibuffer_window))
+      {
+       win = XWINDOW (f->minibuffer_window);
+       WINDOW_LEFT (win) = FRAME_LEFT_BORDER_END (f);
+      }
+  }
+
+  gtk_set_initial_frame_size (f, x, y, w, h);
+}
+
+static gboolean
+resize_event_cb (GtkWidget *w, GtkAllocation *allocation, gpointer user_data)
+{
+  struct frame *f = (struct frame *) user_data;
+
+  f->pixwidth = allocation->width;
+  f->pixheight = allocation->height;
+
+  if (FRAME_GTK_TEXT_WIDGET (f)->window)
+    {
+      Lisp_Object frame;
+      XSETFRAME (frame, f);
+      Fredraw_frame (frame, Qt);
+    }
+
+  return (FALSE);
+}
+
+static gboolean
+delete_event_cb (GtkWidget *w, GdkEvent *ev, gpointer user_data)
+{
+    struct frame *f = (struct frame *) user_data;
+    Lisp_Object frame;
+
+    XSETFRAME (frame, f);
+    enqueue_misc_user_event (frame, Qeval, list3 (Qdelete_frame, frame, Qt));
+
+    /* See if tickling the event queue helps us with our delays when
+       clicking 'close' */
+    signal_fake_event ();
+
+    return (TRUE);
+}
+
+extern gboolean emacs_shell_event_handler (GtkWidget *wid, GdkEvent *event, gpointer closure);
+extern Lisp_Object build_gtk_object (GtkObject *obj);
+
+#ifndef GNOME_IS_APP
+#define GNOME_IS_APP(x) 0
+#define gnome_app_set_contents(x,y) 0
+#endif
+
+static void
+cleanup_deleted_frame (gpointer data)
+{
+  struct frame *f = (struct frame *) data;
+  Lisp_Object frame;
+
+  XSETFRAME (frame, f);
+  Fdelete_frame (frame, Qt);
+}
+
+#ifdef HAVE_DRAGNDROP
+extern void
+dragndrop_data_received (GtkWidget          *widget,
+                        GdkDragContext     *context,
+                        gint                x,
+                        gint                y,
+                        GtkSelectionData   *data,
+                        guint               info,
+                        guint               time);
+
+extern gboolean
+dragndrop_dropped (GtkWidget *widget,
+                  GdkDragContext *drag_context,
+                  gint x,
+                  gint y,
+                  guint time,
+                  gpointer user_data);
+
+Lisp_Object Vcurrent_drag_object;
+
+#define DRAG_SELECTION_DATA_ERROR "Error converting drag data to external format"
+static void
+dragndrop_get_drag (GtkWidget *widget,
+                   GdkDragContext *drag_context,
+                   GtkSelectionData *data,
+                   guint info,
+                   guint time,
+                   gpointer user_data)
+{
+  gtk_selection_data_set (data, GDK_SELECTION_TYPE_STRING, 8,
+                         DRAG_SELECTION_DATA_ERROR,
+                         strlen (DRAG_SELECTION_DATA_ERROR));
+
+  switch (info)
+    {
+    case TARGET_TYPE_STRING:
+      {
+       Lisp_Object string = Vcurrent_drag_object;
+       
+       if (!STRINGP (Vcurrent_drag_object))
+         {
+           string = Fprin1_to_string (string, Qnil);
+           /* Convert to a string */
+         }
+       
+       gtk_selection_data_set (data, GDK_SELECTION_TYPE_STRING,
+                               8, XSTRING_DATA (string), XSTRING_LENGTH (string));
+      }
+      break;
+    case TARGET_TYPE_URI_LIST:
+      break;
+    default:
+      break;
+    }
+  Vcurrent_drag_object = Qnil;
+}
+
+DEFUN ("gtk-start-drag-internal", Fgtk_start_drag_internal, 2, 3, 0, /*
+Start a GTK drag from a buffer.
+First arg is the event that started the drag,
+second arg should be some string, and the third
+is the type of the data (this should be a MIME type as a string (ie: text/plain)).
+The type defaults to text/plain.
+*/
+       (event, data, dtyp))
+{
+  if (EVENTP(event))
+    {
+      struct frame *f = decode_gtk_frame (Fselected_frame (Qnil));
+      GtkWidget *wid = FRAME_GTK_TEXT_WIDGET (f);
+      struct Lisp_Event *lisp_event = XEVENT(event);
+      GdkAtom dnd_typ;
+      GtkTargetList *tl = gtk_target_list_new (dnd_target_table, dnd_n_targets);
+
+      /* only drag if this is really a press */
+      if (EVENT_TYPE(lisp_event) != button_press_event)
+       return Qnil;
+
+      /* get the desired type */
+      if (!NILP (dtyp) && STRINGP (dtyp))
+       dnd_typ = gdk_atom_intern (XSTRING_DATA (dtyp), FALSE);
+
+      gtk_drag_begin (wid, tl, GDK_ACTION_COPY, lisp_event->event.button.button, NULL);
+
+      Vcurrent_drag_object = data;
+
+      gtk_target_list_unref (tl);
+    }
+  return Qnil;
+}
+#endif
+
+/* Creates the widgets for a frame.
+   lisp_window_id is a Lisp description of an X window or Xt
+   widget to parse.
+
+   This function does not map the windows.  (That is
+   done by gtk_popup_frame().)
+*/
+static void
+gtk_create_widgets (struct frame *f, Lisp_Object lisp_window_id, Lisp_Object parent)
+{
+  const char *name;
+  GtkWidget *text, *container, *shell;
+  gboolean embedded_p = !NILP (lisp_window_id);
+#ifdef HAVE_MENUBARS
+  int menubar_visible;
+#endif
+
+  if (STRINGP (f->name))
+    TO_EXTERNAL_FORMAT (LISP_STRING, f->name, C_STRING_ALLOCA, name, Qctext);
+  else
+    name = "emacs";
+
+  FRAME_GTK_TOP_LEVEL_FRAME_P (f) = 1;
+
+  if (embedded_p)
+    {
+      CHECK_GTK_OBJECT (lisp_window_id);
+
+      if (!GTK_IS_CONTAINER (XGTK_OBJECT (lisp_window_id)->object))
+       {
+         signal_simple_error ("Window ID must be a GtkContainer subclass", lisp_window_id);
+       }
+
+      shell = gtk_vbox_new (FALSE, 0);
+
+      gtk_object_weakref (GTK_OBJECT (shell), cleanup_deleted_frame, f);
+      gtk_container_add (GTK_CONTAINER (XGTK_OBJECT (lisp_window_id)->object), shell);
+    }
+  else
+    {
+#ifdef HAVE_GNOME
+      shell = GTK_WIDGET (gnome_app_new ("XEmacs", "XEmacs/GNOME"));
+#else
+      shell = GTK_WIDGET (gtk_window_new (GTK_WINDOW_TOPLEVEL));
+#endif
+    }
+
+  if (!NILP (parent))
+  {
+      /* If this is a transient window, keep the parent info around */
+      GtkWidget *parentwid = FRAME_GTK_SHELL_WIDGET (XFRAME (parent));
+      gtk_object_set_data (GTK_OBJECT (shell), TRANSIENT_DATA_IDENTIFIER, parentwid);
+      gtk_window_set_transient_for (GTK_WINDOW (shell), GTK_WINDOW (parentwid));
+  }
+
+  gtk_container_set_border_width (GTK_CONTAINER (shell), 0);
+
+  gtk_object_set_data (GTK_OBJECT (shell), FRAME_DATA_IDENTIFIER, f);
+
+  FRAME_GTK_SHELL_WIDGET (f) = shell;
+
+  text = GTK_WIDGET (gtk_xemacs_new (f));
+
+  if (!GNOME_IS_APP (shell))
+    container = GTK_WIDGET (gtk_vbox_new (FALSE, INTERNAL_BORDER_WIDTH));
+  else
+    container = shell;
+
+  FRAME_GTK_CONTAINER_WIDGET (f) = container;
+  FRAME_GTK_TEXT_WIDGET (f) = text;
+
+#ifdef HAVE_DRAGNDROP
+  gtk_drag_dest_set (text, GTK_DEST_DEFAULT_MOTION | GTK_DEST_DEFAULT_HIGHLIGHT,
+                    dnd_target_table, dnd_n_targets,
+                    GDK_ACTION_COPY | GDK_ACTION_LINK | GDK_ACTION_ASK);
+  gtk_signal_connect (GTK_OBJECT (text), "drag_drop",
+                     GTK_SIGNAL_FUNC (dragndrop_dropped), text);
+  gtk_signal_connect (GTK_OBJECT (text), "drag_data_received",
+                     GTK_SIGNAL_FUNC (dragndrop_data_received), text);
+  gtk_signal_connect (GTK_OBJECT (text), "drag_data_get",
+                     GTK_SIGNAL_FUNC (dragndrop_get_drag), NULL);
+#endif
+
+#ifdef HAVE_MENUBARS
+  /* Create the initial menubar widget. */
+  menubar_visible = gtk_initialize_frame_menubar (f);
+
+  if (menubar_visible)
+    {
+      gtk_widget_show_all (FRAME_GTK_MENUBAR_WIDGET (f));
+    }
+#endif /* HAVE_MENUBARS */
+
+  if (GNOME_IS_APP (shell))
+    gnome_app_set_contents (GNOME_APP (shell), text);
+  else
+    /* Now comes the drawing area, which should fill the rest of the
+    ** frame completely.
+    */
+    gtk_box_pack_end (GTK_BOX (container), text, TRUE, TRUE, 0);
+
+  /* Connect main event handler */
+  gtk_signal_connect (GTK_OBJECT (shell), "delete-event", GTK_SIGNAL_FUNC (delete_event_cb), f);
+
+  {
+    static char *events_to_frob[] = { "focus-in-event",
+                                     "focus-out-event",
+                                     "enter-notify-event",
+                                     "leave-notify-event",
+                                     "map-event",
+                                     "unmap-event",
+                                     "property-notify-event",
+                                     "selection-clear-event",
+                                     "selection-request-event",
+                                     "selection-notify-event",
+                                     "client-event",
+                                     /* "configure-event", */
+                                     "visibility-notify-event",
+                                     NULL };
+    int i;
+
+    for (i = 0; events_to_frob[i]; i++)
+      {
+       gtk_signal_connect (GTK_OBJECT (shell), events_to_frob[i],
+                           GTK_SIGNAL_FUNC (emacs_shell_event_handler), f);
+      }
+  }
+
+  gtk_signal_connect (GTK_OBJECT (shell), "size-allocate", GTK_SIGNAL_FUNC (resize_event_cb), f);
+
+  /* This might be safe to call now... */
+  /* gtk_signal_connect (GTK_OBJECT (shell), "event", GTK_SIGNAL_FUNC (emacs_shell_event_handler), f); */
+
+  /* Let's make sure we get all the events we can */
+  gtk_widget_set_events (text, GDK_ALL_EVENTS_MASK);
+
+  if (shell != container)
+    gtk_container_add (GTK_CONTAINER (shell), container);
+
+  gtk_widget_set_name (shell, "XEmacs::shell");
+  gtk_widget_set_name (container, "XEmacs::container");
+  gtk_widget_set_name (text, "XEmacs::text");
+
+  FRAME_GTK_LISP_WIDGETS(f)[0] = build_gtk_object (GTK_OBJECT (shell));
+  FRAME_GTK_LISP_WIDGETS(f)[1] = build_gtk_object (GTK_OBJECT (container));
+  FRAME_GTK_LISP_WIDGETS(f)[2] = build_gtk_object (GTK_OBJECT (text));
+
+  gtk_widget_realize (shell);
+}
+
+/* create the windows for the specified frame and display them.
+   Note that the widgets have already been created, and any
+   necessary geometry calculations have already been done. */
+static void
+gtk_popup_frame (struct frame *f)
+{
+  /* */
+
+  if (gtk_object_get_data (GTK_OBJECT (FRAME_GTK_SHELL_WIDGET (f)), UNMAPPED_DATA_IDENTIFIER))
+    {
+      FRAME_GTK_TOTALLY_VISIBLE_P (f) = 0;
+      f->visible = 0;
+      gtk_widget_realize (FRAME_GTK_SHELL_WIDGET (f));
+      gtk_widget_realize (FRAME_GTK_TEXT_WIDGET (f));
+      gtk_widget_hide_all (FRAME_GTK_SHELL_WIDGET (f));
+    }
+  else
+    {
+      gtk_widget_show_all (FRAME_GTK_SHELL_WIDGET (f));
+    }
+}
+
+static void
+allocate_gtk_frame_struct (struct frame *f)
+{
+  /* zero out all slots. */
+  f->frame_data = xnew_and_zero (struct gtk_frame);
+
+  /* yeah, except the lisp ones */
+  FRAME_GTK_ICON_PIXMAP (f) = Qnil;
+  FRAME_GTK_ICON_PIXMAP_MASK (f) = Qnil;
+}
+
+\f
+/************************************************************************/
+/*                             Lisp functions                          */
+/************************************************************************/
+
+static void
+gtk_init_frame_1 (struct frame *f, Lisp_Object props)
+{
+  /* This function can GC */
+  Lisp_Object initially_unmapped;
+  Lisp_Object device = FRAME_DEVICE (f);
+  Lisp_Object lisp_window_id = Fplist_get (props, Qwindow_id, Qnil);
+  Lisp_Object popup = Fplist_get (props, Qpopup, Qnil);
+
+  if (!NILP (popup))
+    {
+      if (EQ (popup, Qt))
+       popup = Fselected_frame (device);
+      CHECK_LIVE_FRAME (popup);
+      if (!EQ (device, FRAME_DEVICE (XFRAME (popup))))
+       signal_simple_error_2 ("Parent must be on same device as frame",
+                              device, popup);
+    }
+
+  initially_unmapped = Fplist_get (props, Qinitially_unmapped, Qnil);
+
+  /*
+   * Previously we set this only if NILP (DEVICE_SELECTED_FRAME (d))
+   * to make sure that messages were displayed as soon as possible
+   * if we're creating the first frame on a device.  But it is
+   * better to just set this all the time, so that when a new frame
+   * is created that covers the selected frame, echo area status
+   * messages can still be seen.  f->visible is reset later if the
+   * initially-unmapped property is found to be non-nil in the
+   * frame properties.
+   */
+  f->visible = 1;
+
+  allocate_gtk_frame_struct (f);
+  gtk_create_widgets (f, lisp_window_id, popup);
+
+  if (!NILP (initially_unmapped))
+    {
+      gtk_object_set_data (GTK_OBJECT (FRAME_GTK_SHELL_WIDGET (f)),
+                          UNMAPPED_DATA_IDENTIFIER, (gpointer) 1);
+    }
+}
+
+static void
+gtk_init_frame_2 (struct frame *f, Lisp_Object props)
+{
+  /* Set up the values of the widget/frame.  A case could be made for putting
+     this inside of the widget's initialize method. */
+
+  update_frame_face_values (f);
+  gtk_initialize_frame_size (f);
+  /* Kyle:
+   *   update_frame_title() can't be done here, because some of the
+   *   modeline specs depend on the frame's device having a selected
+   *   frame, and that may not have been set up yet.  The redisplay
+   *   will update the frame title anyway, so nothing is lost.
+   * JV:
+   *   It turns out it gives problems with FVWMs name based mapping.
+   *   We'll just  need to be carefull in the modeline specs.
+   */
+  update_frame_title (f); 
+}
+
+static void
+gtk_init_frame_3 (struct frame *f)
+{
+  /* Pop up the frame. */
+  gtk_popup_frame (f);
+}
+
+static void
+gtk_mark_frame (struct frame *f)
+{
+  mark_object (FRAME_GTK_ICON_PIXMAP (f));
+  mark_object (FRAME_GTK_ICON_PIXMAP_MASK (f));
+  mark_object (FRAME_GTK_LISP_WIDGETS (f)[0]);
+  mark_object (FRAME_GTK_LISP_WIDGETS (f)[1]);
+  mark_object (FRAME_GTK_LISP_WIDGETS (f)[2]);
+}
+
+static void
+gtk_set_frame_icon (struct frame *f)
+{
+  GdkPixmap *gtk_pixmap = NULL, *gtk_mask = NULL;
+
+  if (IMAGE_INSTANCEP (f->icon)
+      && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (f->icon)))
+    {
+      gtk_pixmap = XIMAGE_INSTANCE_GTK_PIXMAP (f->icon);
+      gtk_mask = XIMAGE_INSTANCE_GTK_MASK (f->icon);
+    }
+  else
+    {
+      gtk_pixmap = 0;
+      gtk_mask = 0;
+    }
+
+  gdk_window_set_icon (GET_GTK_WIDGET_WINDOW (FRAME_GTK_SHELL_WIDGET (f)), NULL, gtk_pixmap, gtk_mask);
+}
+
+static void
+gtk_set_frame_pointer (struct frame *f)
+{
+  GtkWidget *w = FRAME_GTK_TEXT_WIDGET (f);
+  GdkCursor *c = XIMAGE_INSTANCE_GTK_CURSOR (f->pointer);
+
+  if (POINTER_IMAGE_INSTANCEP (f->pointer))
+    {
+      gdk_window_set_cursor (GET_GTK_WIDGET_WINDOW (w), c);
+      gdk_flush ();
+    }
+  else
+    {
+      /* abort()? */
+      stderr_out ("POINTER_IMAGE_INSTANCEP (f->pointer) failed!\n");
+    }
+}
+
+static Lisp_Object
+gtk_get_frame_parent (struct frame *f)
+{
+    GtkWidget *parentwid = gtk_object_get_data (GTK_OBJECT (FRAME_GTK_SHELL_WIDGET (f)),
+                                               TRANSIENT_DATA_IDENTIFIER);
+
+    /* find the frame whose wid is parentwid */
+    if (parentwid)
+    {
+       Lisp_Object frmcons;
+       DEVICE_FRAME_LOOP (frmcons, XDEVICE (FRAME_DEVICE (f)))
+           {
+               Lisp_Object frame = XCAR (frmcons);
+               if (FRAME_GTK_SHELL_WIDGET (XFRAME (frame)) == parentwid)
+                   return frame;
+           }
+    }
+    return Qnil;
+}
+
+#ifdef STUPID_X_SPECIFIC_GTK_STUFF
+DEFUN ("gtk-window-id", Fgtk_window_id, 0, 1, 0, /*
+Get the ID of the Gtk window.
+This gives us a chance to manipulate the Emacs window from within a
+different program.  Since the ID is an unsigned long, we return it as
+a string.
+*/
+       (frame))
+{
+  char str[255];
+  struct frame *f = decode_gtk_frame (frame);
+
+  /* Arrrrggghhh... this defeats the whole purpose of using Gdk... do we really need this? */
+  sprintf (str, "%lu", GDK_WINDOW_XWINDOW( GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (f))));
+  return build_string (str);
+}
+#endif
+
+\f
+/************************************************************************/
+/*                     manipulating the X window                       */
+/************************************************************************/
+
+static void
+gtk_set_frame_position (struct frame *f, int xoff, int yoff)
+{
+    gtk_widget_set_uposition (FRAME_GTK_SHELL_WIDGET (f), xoff, yoff);
+}
+
+/* Call this to change the size of frame S's x-window. */
+
+static void
+gtk_set_frame_size (struct frame *f, int cols, int rows)
+{
+  GtkWidget *shell = FRAME_GTK_SHELL_WIDGET (f);
+  GdkGeometry geometry;
+  GdkWindowHints geometry_mask = 0x00;
+
+  if (GTK_IS_WINDOW (shell))
+    {
+      /* Update the cell size */
+      default_face_height_and_width (make_frame (f), &geometry.height_inc, &geometry.width_inc);
+      geometry_mask |= GDK_HINT_RESIZE_INC;
+
+      gtk_window_set_geometry_hints (GTK_WINDOW (shell),
+                                    FRAME_GTK_TEXT_WIDGET (f), &geometry, geometry_mask);
+    }
+
+  change_frame_size (f, rows, cols, 0);
+
+  {
+    GtkRequisition req;
+
+    gtk_widget_size_request (FRAME_GTK_SHELL_WIDGET (f), &req);
+    gtk_widget_set_usize (FRAME_GTK_SHELL_WIDGET (f), req.width, req.height);
+  }
+}
+
+#ifdef STUPID_X_SPECIFIC_GTK_STUFF
+/* There is NO equivalent to XWarpPointer under Gtk */
+static void
+gtk_set_mouse_position (struct window *w, int x, int y)
+{
+  struct frame *f = XFRAME (w->frame);
+  Display *display = GDK_DISPLAY ();
+  XWarpPointer (display, None,
+               GDK_WINDOW_XWINDOW (GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (f))),
+                0, 0, 0, 0, w->pixel_left + x, w->pixel_top + y);
+}
+#endif /* STUPID_X_SPECIFIC_GTK_STUFF */
+
+static int
+gtk_get_mouse_position (struct device *d, Lisp_Object *frame, int *x, int *y)
+{
+    /* Returns the pixel position within the editor text widget */
+    gint win_x, win_y;
+    GdkWindow *w = gdk_window_at_pointer (&win_x, &win_y);
+    struct frame *f = NULL;
+
+    if (!w) return (0);
+
+    /* At this point, w is the innermost GdkWindow containing the
+    ** pointer and win_x and win_y are the coordinates of that window.
+    */
+    f = gtk_any_window_to_frame (d, w);
+
+    if (!f) return (0);
+
+    XSETFRAME (*frame, f);
+
+    gdk_window_get_pointer (GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (f)),
+                           &win_x, &win_y, NULL);
+
+    *x = win_x;
+    *y = win_y;
+
+    return (1);
+}
+
+static void
+gtk_cant_notify_wm_error (void)
+{
+  error ("Can't notify window manager of iconification.");
+}
+
+/* Raise frame F.  */
+static void
+gtk_raise_frame_1 (struct frame *f, int force)
+{
+  if (FRAME_VISIBLE_P (f) || force)
+    {
+      GdkWindow *emacs_window = GET_GTK_WIDGET_WINDOW (FRAME_GTK_SHELL_WIDGET (f));
+
+      gdk_window_raise (emacs_window);
+    }
+}
+
+static void
+gtk_raise_frame (struct frame *f)
+{
+  gtk_raise_frame_1 (f, 1);
+}
+
+/* Lower frame F.  */
+static void
+gtk_lower_frame (struct frame *f)
+{
+  if (FRAME_VISIBLE_P (f))
+    {
+       gdk_window_lower (GET_GTK_WIDGET_WINDOW (FRAME_GTK_SHELL_WIDGET (f)));
+    }
+}
+
+/* Change from withdrawn state to mapped state. */
+static void
+gtk_make_frame_visible (struct frame *f)
+{
+    gtk_widget_show_all (FRAME_GTK_SHELL_WIDGET (f));
+    gtk_raise_frame_1 (f, 0);
+}
+
+/* Change from mapped state to withdrawn state. */
+static void
+gtk_make_frame_invisible (struct frame *f)
+{
+    gtk_widget_hide (FRAME_GTK_SHELL_WIDGET (f));
+}
+
+static int
+gtk_frame_visible_p (struct frame *f)
+{
+    GtkWidget *w = FRAME_GTK_SHELL_WIDGET (f);
+
+    f->visible = (GTK_OBJECT_FLAGS (w) & GTK_VISIBLE);
+
+    return f->visible;
+}
+
+static int
+gtk_frame_totally_visible_p (struct frame *f)
+{
+  return FRAME_GTK_TOTALLY_VISIBLE_P (f);
+}
+
+/* Change window state from mapped to iconified. */
+static void
+gtk_iconify_frame (struct frame *f)
+{
+  GdkWindow *w = GET_GTK_WIDGET_WINDOW (FRAME_GTK_SHELL_WIDGET (f));
+
+  /* There is no equivalent to XIconifyWindow in Gtk/Gdk. */
+  if (!XIconifyWindow (GDK_WINDOW_XDISPLAY (w),
+                      GDK_WINDOW_XWINDOW (w),
+                      DefaultScreen (GDK_WINDOW_XDISPLAY (w))))
+    gtk_cant_notify_wm_error ();
+
+  f->iconified = 1;
+}
+
+/* Sets the X focus to frame f. */
+static void
+gtk_focus_on_frame (struct frame *f)
+{
+  GtkWidget *shell_widget;
+
+  assert (FRAME_GTK_P (f));
+
+  shell_widget = FRAME_GTK_SHELL_WIDGET (f);
+  if (!GET_GTK_WIDGET_WINDOW (shell_widget))
+    return;
+
+  gtk_widget_grab_focus (shell_widget);
+}
+
+/* Destroy the window of frame S.  */
+static void
+gtk_delete_frame (struct frame *f)
+{
+    GtkWidget *w = FRAME_GTK_SHELL_WIDGET (f);
+
+    gtk_widget_destroy (w);
+
+    if (FRAME_GTK_GEOM_FREE_ME_PLEASE (f))
+       xfree (FRAME_GTK_GEOM_FREE_ME_PLEASE (f));
+    xfree (f->frame_data);
+    f->frame_data = 0;
+}
+
+static void
+gtk_recompute_cell_sizes (struct frame *frm)
+{
+  if (GTK_IS_WINDOW (FRAME_GTK_SHELL_WIDGET (frm)))
+    {
+      GtkWindow *w = GTK_WINDOW (FRAME_GTK_SHELL_WIDGET (frm));
+      GdkGeometry geometry;
+      GdkWindowHints geometry_mask;
+      gint width_inc = 10;
+      gint height_inc = 10;
+
+      default_face_height_and_width (make_frame (frm), &height_inc, &width_inc);
+      geometry_mask = GDK_HINT_RESIZE_INC;
+      geometry.width_inc = width_inc;
+      geometry.height_inc = height_inc;
+
+      gtk_window_set_geometry_hints (w, FRAME_GTK_TEXT_WIDGET (frm), &geometry, geometry_mask);
+    }
+}
+
+static void
+gtk_update_frame_external_traits (struct frame* frm, Lisp_Object name)
+{
+  Lisp_Object frame = Qnil;
+
+  XSETFRAME(frame, frm);
+
+  if (EQ (name, Qforeground))
+   {
+     Lisp_Object color = FACE_FOREGROUND (Vdefault_face, frame);
+     GdkColor *fgc;
+
+     if (!EQ (color, Vthe_null_color_instance))
+       {
+        fgc = COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (color));
+        /* #### BILL!!! The X code set the XtNforeground property of
+           the text widget here.  Why did they bother?  All that type
+           of thing is done down in the guts of the redisplay code,
+           not in the Emacs* widgets. */
+       }
+   }
+  else if (EQ (name, Qbackground))
+   {
+     Lisp_Object color = FACE_BACKGROUND (Vdefault_face, frame);
+     GdkColor *bgc;
+
+     if (!EQ (color, Vthe_null_color_instance))
+       {
+        bgc = COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (color));
+        if (FRAME_GTK_SHELL_WIDGET (frm)->window)
+          {
+            gdk_window_set_background (FRAME_GTK_SHELL_WIDGET (frm)->window, bgc);
+          }
+        if (FRAME_GTK_TEXT_WIDGET (frm)->window)
+          {
+            gdk_window_set_background (FRAME_GTK_TEXT_WIDGET (frm)->window, bgc);
+          }
+       }
+
+     /* Really crappy way to force the modeline shadows to be
+       redrawn.  But effective. */
+     MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (frm);
+     MARK_FRAME_CHANGED (frm);
+   }
+  else if (EQ (name, Qfont))
+   {
+     Lisp_Object font = FACE_FONT (Vdefault_face, frame, Vcharset_ascii);
+
+     if (!EQ (font, Vthe_null_font_instance))
+     {
+        /* #### BILL!!! The X code set the XtNfont property of the
+           text widget here.  Why did they bother?  All that type of
+           thing is done down in the guts of the redisplay code, not
+           in the Emacs* widgets. */
+     }
+   }
+  else
+   abort ();
+
+#ifdef HAVE_TOOLBARS
+  /* Setting the background clears the entire frame area
+    including the toolbar so we force an immediate redraw of
+    it. */
+  if (EQ (name, Qbackground))
+    MAYBE_DEVMETH (XDEVICE (frm->device), redraw_frame_toolbars, (frm));
+#endif /* HAVE_TOOLBARS */
+
+  /* Set window manager resize increment hints according to
+     the new character size */
+  if (EQ (name, Qfont) && FRAME_GTK_TOP_LEVEL_FRAME_P (frm))
+         gtk_recompute_cell_sizes (frm);
+}
+
+\f
+/************************************************************************/
+/*                            initialization                            */
+/************************************************************************/
+
+void
+syms_of_frame_gtk (void)
+{
+  defsymbol (&Qwindow_id, "window-id");
+  defsymbol (&Qtext_widget, "text-widget");
+  defsymbol (&Qcontainer_widget, "container-widget");
+  defsymbol (&Qshell_widget, "shell-widget");
+  defsymbol (&Qdetachable_menubar, "detachable-menubar");
+
+#ifdef HAVE_DRAGNDROP
+  staticpro (&Vcurrent_drag_object);
+  Vcurrent_drag_object = Qnil;
+  DEFSUBR (Fgtk_start_drag_internal);
+#endif
+#ifdef STUPID_X_SPECIFIC_GTK_STUFF
+  DEFSUBR (Fgtk_window_id);
+#endif
+}
+
+void
+console_type_create_frame_gtk (void)
+{
+  /* frame methods */
+  CONSOLE_HAS_METHOD (gtk, init_frame_1);
+  CONSOLE_HAS_METHOD (gtk, init_frame_2);
+  CONSOLE_HAS_METHOD (gtk, init_frame_3);
+  CONSOLE_HAS_METHOD (gtk, mark_frame);
+  CONSOLE_HAS_METHOD (gtk, focus_on_frame);
+  CONSOLE_HAS_METHOD (gtk, delete_frame);
+  CONSOLE_HAS_METHOD (gtk, get_mouse_position);
+#ifdef STUPID_X_SPECIFIC_GTK_STUFF
+  CONSOLE_HAS_METHOD (gtk, set_mouse_position);
+#endif
+  CONSOLE_HAS_METHOD (gtk, raise_frame);
+  CONSOLE_HAS_METHOD (gtk, lower_frame);
+  CONSOLE_HAS_METHOD (gtk, make_frame_visible);
+  CONSOLE_HAS_METHOD (gtk, make_frame_invisible);
+  CONSOLE_HAS_METHOD (gtk, iconify_frame);
+  CONSOLE_HAS_METHOD (gtk, set_frame_size);
+  CONSOLE_HAS_METHOD (gtk, set_frame_position);
+  CONSOLE_HAS_METHOD (gtk, frame_property);
+  CONSOLE_HAS_METHOD (gtk, internal_frame_property_p);
+  CONSOLE_HAS_METHOD (gtk, frame_properties);
+  CONSOLE_HAS_METHOD (gtk, set_frame_properties);
+  CONSOLE_HAS_METHOD (gtk, set_title_from_bufbyte);
+  CONSOLE_HAS_METHOD (gtk, set_icon_name_from_bufbyte);
+  CONSOLE_HAS_METHOD (gtk, frame_visible_p);
+  CONSOLE_HAS_METHOD (gtk, frame_totally_visible_p);
+  CONSOLE_HAS_METHOD (gtk, frame_iconified_p);
+  CONSOLE_HAS_METHOD (gtk, set_frame_pointer);
+  CONSOLE_HAS_METHOD (gtk, set_frame_icon);
+  CONSOLE_HAS_METHOD (gtk, get_frame_parent);
+  CONSOLE_HAS_METHOD (gtk, update_frame_external_traits);
+}
+
+void
+vars_of_frame_gtk (void)
+{
+  DEFVAR_LISP ("default-gtk-frame-plist", &Vdefault_gtk_frame_plist /*
+Plist of default frame-creation properties for Gtk frames.
+These override what is specified in the resource database and in
+`default-frame-plist', but are overridden by the arguments to the
+particular call to `make-frame'.
+
+Note: In many cases, properties of a frame are available as specifiers
+instead of through the frame-properties mechanism.
+
+Here is a list of recognized frame properties, other than those
+documented in `set-frame-properties' (they can be queried and
+set at any time, except as otherwise noted):
+
+  initially-unmapped           If non-nil, the frame will not be visible
+                               when it is created.  In this case, you
+                               need to call `make-frame-visible' to make
+                               the frame appear.
+  popup                                If non-nil, it should be a frame, and this
+                               frame will be created as a "popup" frame
+                               whose parent is the given frame.  This
+                               will make the window manager treat the
+                               frame as a dialog box, which may entail
+                               doing different things (e.g. not asking
+                               for positioning, and not iconifying
+                               separate from its parent).
+  inter-line-space             Not currently implemented.
+  toolbar-shadow-thickness     Thickness of toolbar shadows.
+  background-toolbar-color     Color of toolbar background.
+  bottom-toolbar-shadow-color  Color of bottom shadows on toolbars.
+                               (*Not* specific to the bottom-toolbar.)
+  top-toolbar-shadow-color     Color of top shadows on toolbars.
+                               (*Not* specific to the top-toolbar.)
+  internal-border-width                Width of internal border around text area.
+  border-width                 Width of external border around text area.
+  top                          Y position (in pixels) of the upper-left
+                               outermost corner of the frame (i.e. the
+                               upper-left of the window-manager
+                               decorations).
+  left                         X position (in pixels) of the upper-left
+                               outermost corner of the frame (i.e. the
+                               upper-left of the window-manager
+                               decorations).
+  border-color                 Color of external border around text area.
+  cursor-color                 Color of text cursor.
+
+See also `default-frame-plist', which specifies properties which apply
+to all frames, not just Gtk frames.
+*/ );
+  Vdefault_gtk_frame_plist = Qnil;
+
+  gtk_console_methods->device_specific_frame_props = &Vdefault_gtk_frame_plist;
+}

diff --git a/src/gccache-gtk.c b/src/gccache-gtk.c
new file mode 100644 (file)
index 0000000..afc5830
--- /dev/null
+++ b/src/gccache-gtk.c
@@ -0,0 +1,276 @@
+/* Efficient caching of Gtk GCs (graphics contexts).
+   Copyright (C) 1993 Free Software Foundation, Inc.
+   Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
+
+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, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with: Not in FSF. */
+
+/* Emacs uses a lot of different display attributes; for example, assume
+   that only four fonts are in use (normal, bold, italic, and bold-italic).
+   Then assume that one stipple or background is used for text selections,
+   and another is used for highlighting mousable regions.  That makes 16
+   GCs already.  Add in the fact that another GC may be needed to display
+   the text cursor in any of those regions, and you've got 32.  Add in
+   more fonts, and it keeps increasing exponentially.
+
+   We used to keep these GCs in a cache of merged (fully qualified) faces.
+   However, a lot of other code in xterm.c used XChangeGC of existing GCs,
+   which is kind of slow and kind of random.  Also, managing the face cache
+   was tricky because it was hard to know when a face was no longer visible
+   on the frame -- we had to mark all frames as garbaged whenever a face
+   was changed, which caused an unpleasant amount of flicker (since faces are
+   created/destroyed (= changed) whenever a frame is created/destroyed.
+
+   So this code maintains a cache at the GC level instead of at the face
+   level.  There is an upper limit on the size of the cache, after which we
+   will stop creating GCs and start reusing them (reusing the least-recently-
+   used ones first).  So if faces get changed, their GCs will eventually be
+   recycled.  Also more sharing of GCs is possible.
+
+   This code uses hashtables.  It could be that, if the cache size is small
+   enough, a linear search might be faster; but I doubt it, since we need
+   `equal' comparisons, not `eq', and I expect that the optimal cache size
+   will be ~100.
+
+   Written by jwz, 14 jun 93
+   Hacked by William Perry, apr 2000
+ */
+
+#include <config.h>
+#include <gtk/gtk.h>
+#include "lisp.h"
+#include "gccache-gtk.h"
+
+#define GC_CACHE_SIZE 100
+
+#define GCCACHE_HASH
+
+#ifdef GCCACHE_HASH
+#include "lisp.h"
+#include "hash.h"
+#endif
+
+struct gcv_and_mask {
+       GdkGCValues gcv;
+       GdkGCValuesMask mask;
+};
+
+struct gc_cache_cell {
+  GdkGC *gc;
+  struct gcv_and_mask gcvm;
+  struct gc_cache_cell *prev, *next;
+};
+
+struct gc_cache {
+  GdkWindow *window;   /* used only as arg to XCreateGC */
+  int size;
+  struct gc_cache_cell *head;
+  struct gc_cache_cell *tail;
+#ifdef GCCACHE_HASH
+  struct hash_table * table;
+#endif
+
+  int create_count;
+  int delete_count;
+};
+
+#ifdef GCCACHE_HASH
+static unsigned long
+gc_cache_hash (const void *arg)
+{
+  const struct gcv_and_mask *gcvm = (const struct gcv_and_mask *) arg;
+  unsigned long *longs = (unsigned long *) &gcvm->gcv;
+  unsigned long hash = gcvm->mask;
+  int i;
+  /* This could look at the mask and only use the used slots in the
+     hash code.  That would win in that we wouldn't have to initialize
+     every slot of the gcv when calling gc_cache_lookup.  But we need
+     the hash function to be as fast as possible; some timings should
+     be done. */
+  for (i = 0; i < (sizeof (GdkGCValues) / sizeof (unsigned long)); i++)
+    hash = (hash<<1) ^ *longs++;
+  return hash;
+}
+
+#endif /* GCCACHE_HASH */
+
+static int
+gc_cache_eql (const void *arg1, const void *arg2)
+{
+  /* See comment in gc_cache_hash */
+  const struct gcv_and_mask *gcvm1 = (const struct gcv_and_mask *) arg1;
+  const struct gcv_and_mask *gcvm2 = (const struct gcv_and_mask *) arg2;
+
+  return !memcmp(&gcvm1->gcv, &gcvm2->gcv, sizeof(gcvm1->gcv))
+    && gcvm1->mask == gcvm2->mask;
+}
+
+struct gc_cache *
+make_gc_cache (GtkWidget *widget)
+{
+  struct gc_cache *cache = xnew (struct gc_cache);
+  cache->window = widget->window;
+  cache->size = 0;
+  cache->head = cache->tail = 0;
+  cache->create_count = cache->delete_count = 0;
+#ifdef GCCACHE_HASH
+  cache->table =
+    make_general_hash_table (GC_CACHE_SIZE, gc_cache_hash, gc_cache_eql);
+#endif
+  return cache;
+}
+
+void
+free_gc_cache (struct gc_cache *cache)
+{
+  struct gc_cache_cell *rest, *next;
+  rest = cache->head;
+  while (rest)
+    {
+      gdk_gc_destroy(rest->gc);
+      next = rest->next;
+      xfree (rest);
+      rest = next;
+    }
+#ifdef GCCACHE_HASH
+  free_hash_table (cache->table);
+#endif
+  xfree (cache);
+}
+
+GdkGC *
+gc_cache_lookup (struct gc_cache *cache, GdkGCValues *gcv, GdkGCValuesMask mask)
+{
+  struct gc_cache_cell *cell, *next, *prev;
+  struct gcv_and_mask gcvm;
+
+  if ((!!cache->head) != (!!cache->tail)) abort ();
+  if (cache->head && (cache->head->prev || cache->tail->next)) abort ();
+
+  /* Gdk does not have the equivalent of 'None' for the clip_mask, so
+     we need to check it carefully, or gdk_gc_new_with_values will
+     coredump */
+  if ((mask & GDK_GC_CLIP_MASK) && !gcv->clip_mask)
+  {
+      mask &= ~GDK_GC_CLIP_MASK;
+  }
+
+  gcvm.mask = mask;
+  gcvm.gcv = *gcv;     /* this copies... */
+
+#ifdef GCCACHE_HASH
+
+  if (gethash (&gcvm, cache->table, (const void **) &cell))
+
+#else /* !GCCACHE_HASH */
+
+  cell = cache->tail;  /* start at the end (most recently used) */
+  while (cell)
+    {
+      if (gc_cache_eql (&gcvm, &cell->gcvm))
+       break;
+      else
+       cell = cell->prev;
+    }
+
+  /* #### This whole file needs some serious overhauling. */
+  if (!(mask | GDK_GC_TILE) && cell->gcvm.gcv.tile)
+    cell = 0;
+  else if (!(mask | GDK_GC_STIPPLE) && cell->gcvm.gcv.stipple)
+    cell = 0;
+
+  if (cell)
+
+#endif /* !GCCACHE_HASH */
+
+    {
+      /* Found a cell.  Move this cell to the end of the list, so that it
+        will be less likely to be collected than a cell that was accessed
+        less recently.
+       */
+      if (cell == cache->tail)
+       return cell->gc;
+
+      next = cell->next;
+      prev = cell->prev;
+      if (prev) prev->next = next;
+      if (next) next->prev = prev;
+      if (cache->head == cell) cache->head = next;
+      cell->next = 0;
+      cell->prev = cache->tail;
+      cache->tail->next = cell;
+      cache->tail = cell;
+      if (cache->head == cell) abort ();
+      if (cell->next) abort ();
+      if (cache->head->prev) abort ();
+      if (cache->tail->next) abort ();
+      return cell->gc;
+    }
+
+  /* else, cache miss. */
+
+  if (cache->size == GC_CACHE_SIZE)
+    /* Reuse the first cell on the list (least-recently-used).
+       Remove it from the list, and unhash it from the table.
+     */
+    {
+      cell = cache->head;
+      cache->head = cell->next;
+      cache->head->prev = 0;
+      if (cache->tail == cell) cache->tail = 0; /* only one */
+      gdk_gc_destroy (cell->gc);
+      cache->delete_count++;
+#ifdef GCCACHE_HASH
+      remhash (&cell->gcvm, cache->table);
+#endif
+    }
+  else if (cache->size > GC_CACHE_SIZE)
+    abort ();
+  else
+    {
+      /* Allocate a new cell (don't put it in the list or table yet). */
+      cell = xnew (struct gc_cache_cell);
+      cache->size++;
+    }
+
+  /* Now we've got a cell (new or reused).  Fill it in. */
+  memcpy (&cell->gcvm.gcv, gcv, sizeof (GdkGCValues));
+  cell->gcvm.mask = mask;
+
+  /* Put the cell on the end of the list. */
+  cell->next = 0;
+  cell->prev = cache->tail;
+  if (cache->tail) cache->tail->next = cell;
+  cache->tail = cell;
+  if (! cache->head) cache->head = cell;
+
+  cache->create_count++;
+#ifdef GCCACHE_HASH
+  /* Hash it in the table */
+  puthash (&cell->gcvm, cell, cache->table);
+#endif
+
+  /* Now make and return the GC. */
+  cell->gc = gdk_gc_new_with_values (cache->window, gcv, mask);
+
+  /* debug */
+  assert (cell->gc == gc_cache_lookup (cache, gcv, mask));
+
+  return cell->gc;
+}

diff --git a/src/gccache-gtk.h b/src/gccache-gtk.h
new file mode 100644 (file)
index 0000000..41c9bf6
--- /dev/null
+++ b/src/gccache-gtk.h
@@ -0,0 +1,35 @@
+/* Efficient caching of X GCs (graphics contexts).
+   Copyright (C) 1993 Free Software Foundation, Inc.
+
+
+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, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with: Not in FSF. */
+
+/* Written by jwz, 14 jun 93 */
+/* Hacked by wmperry, apr 2000 */
+
+#ifndef _GCCACHE_GTK_H_
+#define _GCCACHE_GTK_H_
+
+struct gc_cache;
+struct gc_cache *make_gc_cache (GtkWidget *);
+void free_gc_cache (struct gc_cache *cache);
+GdkGC *gc_cache_lookup (struct gc_cache *, GdkGCValues *, GdkGCValuesMask mask);
+
+#endif /* _XGCCACHE_H_ */

diff --git a/src/glade.c b/src/glade.c
new file mode 100644 (file)
index 0000000..b314f20
--- /dev/null
+++ b/src/glade.c
@@ -0,0 +1,136 @@
+/* glade.c
+**
+** Description: Interface to `libglade' for XEmacs/GTK
+**
+** Created by: William M. Perry <wmperry@gnu.org>
+**
+** Copyright (C) 1999 John Harper <john@dcs.warwick.ac.uk>
+** Copyright (c) 2000 Free Software Foundation
+**
+*/
+
+#if defined(HAVE_GLADE_H) || defined(HAVE_GLADE_GLADE_H)
+
+/* For COMPILED_FUNCTIONP */
+#include "bytecode.h"
+
+#ifdef HAVE_GLADE_GLADE_H
+#include <glade/glade.h>
+#endif
+
+#ifdef HAVE_GLADE_H
+#include <glade.h>
+#endif
+
+/* This is based on the code from rep-gtk 0.11 in libglade-support.c */
+
+static void
+connector (const gchar *handler_name, GtkObject *object,
+          const gchar *signal_name, const gchar *signal_data,
+          GtkObject *connect_object, gboolean after, gpointer user_data)
+{
+  Lisp_Object func;
+  Lisp_Object lisp_data = Qnil;
+
+  VOID_TO_LISP (func, user_data);
+
+  if (NILP (func))
+    {
+      /* Look for a lisp function called HANDLER_NAME */
+      func = intern (handler_name);
+    }
+
+  if (signal_data && signal_data[0])
+    {
+      lisp_data = Feval (Fread (build_string (signal_data)));
+    }
+
+  /* obj, name, func, cb_data, object_signal, after_p */
+  Fgtk_signal_connect (build_gtk_object (object),
+                      intern (signal_name),
+                      func,
+                      lisp_data,
+                      connect_object ? Qt : Qnil,
+                      after ? Qt : Qnil);
+}
+
+/* This differs from lisp/subr.el (functionp) definition by allowing
+** symbol names that may not necessarily be fboundp yet.
+*/
+static int __almost_functionp (Lisp_Object obj)
+{
+  return (SYMBOLP (obj) ||
+         SUBRP (obj) ||
+         COMPILED_FUNCTIONP (obj) ||
+         EQ (Fcar_safe (obj), Qlambda));
+}
+
+DEFUN ("glade-xml-signal-connect", Fglade_xml_signal_connect, 3, 3, 0, /*
+Connect a glade handler.
+*/
+       (xml, handler_name, func))
+{
+  CHECK_GTK_OBJECT (xml);
+  CHECK_STRING (handler_name);
+
+  if (!__almost_functionp (func))
+    {
+      func = wrong_type_argument (intern ("functionp"), func);
+    }
+
+  glade_xml_signal_connect_full (GLADE_XML (XGTK_OBJECT (xml)->object),
+                                XSTRING_DATA (handler_name),
+                                connector, LISP_TO_VOID (func));
+  return (Qt);
+}
+
+DEFUN ("glade-xml-signal-autoconnect", Fglade_xml_signal_autoconnect, 1, 1, 0, /*
+Connect all glade handlers.
+*/
+       (xml))
+{
+  CHECK_GTK_OBJECT (xml);
+
+  glade_xml_signal_autoconnect_full (GLADE_XML (XGTK_OBJECT (xml)->object),
+                                    connector, LISP_TO_VOID (Qnil));
+  return (Qt);
+}
+
+DEFUN ("glade-xml-textdomain", Fglade_xml_textdomain, 1, 1, 0, /*
+Return the textdomain of a GladeXML object.
+*/
+       (xml))
+{
+  gchar *the_domain = NULL;
+
+  CHECK_GTK_OBJECT (xml);
+
+  if (!GLADE_IS_XML (XGTK_OBJECT (xml)->object))
+    {
+      signal_simple_error ("Object is not a GladeXML type.", xml);
+    }
+
+#ifdef LIBGLADE_XML_TXTDOMAIN
+  the_domain = GLADE_XML (XGTK_OBJECT (xml)->object)->txtdomain;
+#else
+  the_domain = GLADE_XML (XGTK_OBJECT (xml)->object)->textdomain;
+#endif  
+  return (build_string (the_domain));
+}
+
+void syms_of_glade (void)
+{
+  DEFSUBR (Fglade_xml_signal_connect);
+  DEFSUBR (Fglade_xml_signal_autoconnect);
+  DEFSUBR (Fglade_xml_textdomain);
+}
+
+void vars_of_glade (void)
+{
+  Fprovide (intern ("glade"));
+}
+
+#else /* !(HAVE_GLADE_H || HAVE_GLADE_GLADE_H) */
+#define syms_of_glade()
+#define vars_of_glade()
+#endif

diff --git a/src/glyphs-gtk.c b/src/glyphs-gtk.c
new file mode 100644 (file)
index 0000000..ce6e345
--- /dev/null
+++ b/src/glyphs-gtk.c
@@ -0,0 +1,3033 @@
+/* X-specific Lisp objects.
+   Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+   Copyright (C) 1995 Board of Trustees, University of Illinois.
+   Copyright (C) 1995 Tinker Systems
+   Copyright (C) 1995, 1996 Ben Wing
+   Copyright (C) 1995 Sun Microsystems
+
+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, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with: Not in FSF. */
+
+/* Original author: Jamie Zawinski for 19.8
+   font-truename stuff added by Jamie Zawinski for 19.10
+   subwindow support added by Chuck Thompson
+   additional XPM support added by Chuck Thompson
+   initial X-Face support added by Stig
+   rewritten/restructured by Ben Wing for 19.12/19.13
+   GIF/JPEG support added by Ben Wing for 19.14
+   PNG support added by Bill Perry for 19.14
+   Improved GIF/JPEG support added by Bill Perry for 19.14
+   Cleanup/simplification of error handling by Ben Wing for 19.14
+   Pointer/icon overhaul, more restructuring by Ben Wing for 19.14
+   GIF support changed to external GIFlib 3.1 by Jareth Hein for 21.0
+   Many changes for color work and optimizations by Jareth Hein for 21.0
+   Switch of GIF/JPEG/PNG to new EImage intermediate code by Jareth Hein for 21.0
+   TIFF code by Jareth Hein for 21.0
+   GIF/JPEG/PNG/TIFF code moved to new glyph-eimage.c for 21.0
+   Gtk version by William Perry for 21.1
+
+   TODO:
+   Support the GrayScale, StaticColor and StaticGray visual classes.
+   Convert images.el to C and stick it in here?
+ */
+
+#include <config.h>
+#include "lisp.h"
+#include "lstream.h"
+#include "console-gtk.h"
+#include "glyphs.h"
+#include "glyphs-gtk.h"
+#include "objects-gtk.h"
+#include "gui-gtk.h"
+#include "ui-gtk.h"
+
+#include "buffer.h"
+#include "window.h"
+#include "frame.h"
+#include "insdel.h"
+#include "opaque.h"
+#include "faces.h"
+
+#include "imgproc.h"
+
+#include "sysfile.h"
+
+#include <setjmp.h>
+
+#ifdef FILE_CODING
+#include "file-coding.h"
+#endif
+
+#if INTBITS == 32
+# define FOUR_BYTE_TYPE unsigned int
+#elif LONGBITS == 32
+# define FOUR_BYTE_TYPE unsigned long
+#elif SHORTBITS == 32
+# define FOUR_BYTE_TYPE unsigned short
+#else
+#error What kind of strange-ass system are we running on?
+#endif
+
+DECLARE_IMAGE_INSTANTIATOR_FORMAT (nothing);
+DECLARE_IMAGE_INSTANTIATOR_FORMAT (string);
+DECLARE_IMAGE_INSTANTIATOR_FORMAT (formatted_string);
+DECLARE_IMAGE_INSTANTIATOR_FORMAT (inherit);
+#ifdef HAVE_JPEG
+DECLARE_IMAGE_INSTANTIATOR_FORMAT (jpeg);
+#endif
+#ifdef HAVE_TIFF
+DECLARE_IMAGE_INSTANTIATOR_FORMAT (tiff);
+#endif
+#ifdef HAVE_PNG
+DECLARE_IMAGE_INSTANTIATOR_FORMAT (png);
+#endif
+#ifdef HAVE_GIF
+DECLARE_IMAGE_INSTANTIATOR_FORMAT (gif);
+#endif
+
+#ifdef HAVE_XFACE
+DEFINE_DEVICE_IIFORMAT (gtk, xface);
+Lisp_Object Qxface;
+#endif
+
+#ifdef HAVE_XPM
+DEFINE_DEVICE_IIFORMAT (gtk, xpm);
+#endif
+
+DEFINE_DEVICE_IIFORMAT (gtk, xbm);
+DEFINE_DEVICE_IIFORMAT (gtk, subwindow);
+
+DEFINE_IMAGE_INSTANTIATOR_FORMAT (cursor_font);
+Lisp_Object Qcursor_font;
+
+DEFINE_IMAGE_INSTANTIATOR_FORMAT (font);
+
+DEFINE_IMAGE_INSTANTIATOR_FORMAT (autodetect);
+
+#ifdef HAVE_WIDGETS
+DECLARE_IMAGE_INSTANTIATOR_FORMAT (layout);
+DEFINE_DEVICE_IIFORMAT (gtk, widget);
+DEFINE_DEVICE_IIFORMAT (gtk, native_layout);
+DEFINE_DEVICE_IIFORMAT (gtk, button);
+DEFINE_DEVICE_IIFORMAT (gtk, progress_gauge);
+DEFINE_DEVICE_IIFORMAT (gtk, edit_field);
+DEFINE_DEVICE_IIFORMAT (gtk, combo_box);
+DEFINE_DEVICE_IIFORMAT (gtk, tab_control);
+DEFINE_DEVICE_IIFORMAT (gtk, label);
+#endif
+
+static void update_widget_face (GtkWidget *w, Lisp_Image_Instance *ii,
+                               Lisp_Object domain);
+static void cursor_font_instantiate (Lisp_Object image_instance,
+                                    Lisp_Object instantiator,
+                                    Lisp_Object pointer_fg,
+                                    Lisp_Object pointer_bg,
+                                    int dest_mask,
+                                    Lisp_Object domain);
+
+static gint cursor_name_to_index (const char *name);
+
+#ifndef BitmapSuccess
+#define BitmapSuccess           0
+#define BitmapOpenFailed        1
+#define BitmapFileInvalid       2
+#define BitmapNoMemory          3
+#endif
+
+#include "bitmaps.h"
+
+DEFINE_IMAGE_INSTANTIATOR_FORMAT (gtk_resource);
+Lisp_Object Q_resource_type, Q_resource_id;
+Lisp_Object Qgtk_resource;
+#ifdef HAVE_WIDGETS
+Lisp_Object Qgtk_widget_instantiate_internal, Qgtk_widget_property_internal;
+Lisp_Object Qgtk_widget_redisplay_internal, Qgtk_widget_set_style;
+#endif
+
+#define CONST const
+
+\f
+/************************************************************************/
+/*                      image instance methods                          */
+/************************************************************************/
+
+/************************************************************************/
+/* convert from a series of RGB triples to an XImage formated for the   */
+/* proper display                                                      */
+/************************************************************************/
+static GdkImage *
+convert_EImage_to_GDKImage (Lisp_Object device, int width, int height,
+                           unsigned char *pic, unsigned long **pixtbl,
+                           int *npixels)
+{
+  GdkColormap *cmap;
+  GdkVisual *vis;
+  GdkImage *outimg;
+  int depth, byte_cnt, i, j;
+  int rd,gr,bl,q;
+  unsigned char *data, *ip, *dp = NULL;
+  quant_table *qtable = NULL;
+  union {
+    FOUR_BYTE_TYPE val;
+    char cp[4];
+  } conv;
+
+  cmap = DEVICE_GTK_COLORMAP (XDEVICE(device));
+  vis = DEVICE_GTK_VISUAL (XDEVICE(device));
+  depth = DEVICE_GTK_DEPTH(XDEVICE(device));
+
+  if (vis->type == GDK_VISUAL_GRAYSCALE || vis->type == GDK_VISUAL_STATIC_COLOR ||
+      vis->type == GDK_VISUAL_STATIC_GRAY)
+    {
+      /* #### Implement me!!! */
+      return NULL;
+    }
+
+  if (vis->type == GDK_VISUAL_PSEUDO_COLOR)
+    {
+      /* Quantize the image and get a histogram while we're at it.
+        Do this first to save memory */
+      qtable = build_EImage_quantable(pic, width, height, 256);
+      if (qtable == NULL) return NULL;
+    }
+
+  /* The first parameter (GdkWindow *) is allowed to be NULL if we
+  ** specify the depth */
+  outimg = gdk_image_new (GDK_IMAGE_FASTEST, vis, width, height);
+
+  if (!outimg) return NULL;
+
+  byte_cnt = outimg->bpp;
+
+  data = (unsigned char *) outimg->mem;
+
+  if (!data)
+    {
+      gdk_image_destroy (outimg);
+      return NULL;
+    }
+  
+  if (vis->type == GDK_VISUAL_PSEUDO_COLOR)
+    {
+      unsigned long pixarray[256];
+      int pixcount, n;
+      /* use our quantize table to allocate the colors */
+      pixcount = 32;
+      *pixtbl = xnew_array (unsigned long, pixcount);
+      *npixels = 0;
+
+      /* ### should implement a sort by popularity to assure proper allocation */
+      n = *npixels;
+      for (i = 0; i < qtable->num_active_colors; i++)
+       {
+         GdkColor color;
+         int res;
+       
+         color.red = qtable->rm[i] ? qtable->rm[i] << 8 : 0;
+         color.green = qtable->gm[i] ? qtable->gm[i] << 8 : 0;
+         color.blue = qtable->bm[i] ? qtable->bm[i] << 8 : 0;
+         res = allocate_nearest_color (cmap, vis, &color);
+         if (res > 0 && res < 3)
+           {
+             DO_REALLOC(*pixtbl, pixcount, n+1, unsigned long);
+             (*pixtbl)[n] = color.pixel;
+             n++;
+           }
+         pixarray[i] = color.pixel;
+       }
+      *npixels = n;
+      ip = pic;
+      for (i = 0; i < height; i++)
+       {
+         dp = data + (i * outimg->bpl);
+         for (j = 0; j < width; j++)
+           {
+             rd = *ip++;
+             gr = *ip++;
+             bl = *ip++;
+             conv.val = pixarray[QUANT_GET_COLOR(qtable,rd,gr,bl)];
+#if WORDS_BIGENDIAN
+             if (outimg->byte_order == GDK_MSB_FIRST)
+               for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q];
+             else
+               for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q];
+#else
+             if (outimg->byte_order == GDK_MSB_FIRST)
+               for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q];
+             else
+               for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q];
+#endif
+           }
+       }
+      xfree(qtable);
+    } else {
+      unsigned long rshift,gshift,bshift,rbits,gbits,bbits,junk;
+      junk = vis->red_mask;
+      rshift = 0;
+      while ((junk & 0x1) == 0)
+       {
+         junk = junk >> 1;
+         rshift ++;
+       }
+      rbits = 0;
+      while (junk != 0)
+       {
+         junk = junk >> 1;
+         rbits++;
+       }
+      junk = vis->green_mask;
+      gshift = 0;
+      while ((junk & 0x1) == 0)
+       {
+         junk = junk >> 1;
+         gshift ++;
+       }
+      gbits = 0;
+      while (junk != 0)
+       {
+         junk = junk >> 1;
+         gbits++;
+       }
+      junk = vis->blue_mask;
+      bshift = 0;
+      while ((junk & 0x1) == 0)
+       {
+         junk = junk >> 1;
+         bshift ++;
+       }
+      bbits = 0;
+      while (junk != 0)
+       {
+         junk = junk >> 1;
+         bbits++;
+       }
+      ip = pic;
+      for (i = 0; i < height; i++)
+       {
+         dp = data + (i * outimg->bpl);
+         for (j = 0; j < width; j++)
+           {
+             if (rbits > 8)
+               rd = *ip++ << (rbits - 8);
+             else
+               rd = *ip++ >> (8 - rbits);
+             if (gbits > 8)
+               gr = *ip++ << (gbits - 8);
+             else
+               gr = *ip++ >> (8 - gbits);
+             if (bbits > 8)
+               bl = *ip++ << (bbits - 8);
+             else
+               bl = *ip++ >> (8 - bbits);
+
+             conv.val = (rd << rshift) | (gr << gshift) | (bl << bshift);
+#if WORDS_BIGENDIAN
+             if (outimg->byte_order == GDK_MSB_FIRST)
+               for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q];
+             else
+               for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q];
+#else
+             if (outimg->byte_order == GDK_MSB_FIRST)
+               for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q];
+             else
+               for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q];
+#endif
+           }
+       }
+    }  
+  return outimg;
+}
+
+static void
+gtk_print_image_instance (struct Lisp_Image_Instance *p,
+                         Lisp_Object printcharfun,
+                         int escapeflag)
+{
+  char buf[100];
+
+  switch (IMAGE_INSTANCE_TYPE (p))
+    {
+    case IMAGE_MONO_PIXMAP:
+    case IMAGE_COLOR_PIXMAP:
+    case IMAGE_POINTER:
+      sprintf (buf, " (0x%lx", (unsigned long) IMAGE_INSTANCE_GTK_PIXMAP (p));
+      write_c_string (buf, printcharfun);
+      if (IMAGE_INSTANCE_GTK_MASK (p))
+       {
+         sprintf (buf, "/0x%lx", (unsigned long) IMAGE_INSTANCE_GTK_MASK (p));
+         write_c_string (buf, printcharfun);
+       }
+      write_c_string (")", printcharfun);
+      break;
+#if HAVE_SUBWINDOWS
+    case IMAGE_SUBWINDOW:
+      /* #### implement me */
+#endif
+    default:
+      break;
+    }
+}
+
+static void
+gtk_finalize_image_instance (struct Lisp_Image_Instance *p)
+{
+  if (!p->data)
+    return;
+
+  if (DEVICE_LIVE_P (XDEVICE (p->device)))
+    {
+      if (0)
+       ;
+#ifdef HAVE_WIDGETS
+      if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET)
+       {
+         if (IMAGE_INSTANCE_SUBWINDOW_ID (p))
+           {
+             gtk_widget_destroy (IMAGE_INSTANCE_SUBWINDOW_ID (p));
+
+             /* We can release the callbacks again. */
+             /* #### FIXME! */
+             /* ungcpro_popup_callbacks (...); */
+
+             /* IMAGE_INSTANCE_GTK_WIDGET_ID (p) = 0; */
+             IMAGE_INSTANCE_GTK_CLIPWIDGET (p) = 0;
+           }
+       }
+#endif
+      else if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
+       {
+         abort();
+       }
+      else
+       {
+         int i;
+         if (IMAGE_INSTANCE_PIXMAP_TIMEOUT (p))
+           disable_glyph_animated_timeout (IMAGE_INSTANCE_PIXMAP_TIMEOUT (p));
+
+         if (IMAGE_INSTANCE_GTK_MASK (p) &&
+             IMAGE_INSTANCE_GTK_MASK (p) != IMAGE_INSTANCE_GTK_PIXMAP (p))
+           gdk_pixmap_unref (IMAGE_INSTANCE_GTK_MASK (p));
+         IMAGE_INSTANCE_PIXMAP_MASK (p) = 0;
+
+         if (IMAGE_INSTANCE_GTK_PIXMAP_SLICES (p))
+           {
+             for (i = 0; i < IMAGE_INSTANCE_PIXMAP_MAXSLICE (p); i++)
+               if (IMAGE_INSTANCE_GTK_PIXMAP_SLICE (p,i))
+                 {
+                   gdk_pixmap_unref (IMAGE_INSTANCE_GTK_PIXMAP_SLICE (p,i));
+                   IMAGE_INSTANCE_GTK_PIXMAP_SLICE (p, i) = 0;
+                 }
+             xfree (IMAGE_INSTANCE_GTK_PIXMAP_SLICES (p));
+             IMAGE_INSTANCE_GTK_PIXMAP_SLICES (p) = 0;
+           }
+
+         if (IMAGE_INSTANCE_GTK_CURSOR (p))
+           {
+             gdk_cursor_destroy (IMAGE_INSTANCE_GTK_CURSOR (p));
+             IMAGE_INSTANCE_GTK_CURSOR (p) = 0;
+           }
+       }
+
+#if 0
+           /* #### BILL!!! */
+      if (IMAGE_INSTANCE_GTK_NPIXELS (p) != 0)
+       {
+         XFreeColors (dpy,
+                      IMAGE_INSTANCE_GTK_COLORMAP (p),
+                      IMAGE_INSTANCE_GTK_PIXELS (p),
+                      IMAGE_INSTANCE_GTK_NPIXELS (p), 0);
+         IMAGE_INSTANCE_GTK_NPIXELS (p) = 0;
+       }
+#endif
+    }
+
+  if (IMAGE_INSTANCE_TYPE (p) != IMAGE_WIDGET
+      && IMAGE_INSTANCE_TYPE (p) != IMAGE_SUBWINDOW
+      && IMAGE_INSTANCE_GTK_PIXELS (p))
+    {
+      xfree (IMAGE_INSTANCE_GTK_PIXELS (p));
+      IMAGE_INSTANCE_GTK_PIXELS (p) = 0;
+    }
+
+  xfree (p->data);
+  p->data = 0;
+}
+
+static int
+gtk_image_instance_equal (struct Lisp_Image_Instance *p1,
+                         struct Lisp_Image_Instance *p2, int depth)
+{
+  switch (IMAGE_INSTANCE_TYPE (p1))
+    {
+    case IMAGE_MONO_PIXMAP:
+    case IMAGE_COLOR_PIXMAP:
+    case IMAGE_POINTER:
+      if (IMAGE_INSTANCE_GTK_COLORMAP (p1) != IMAGE_INSTANCE_GTK_COLORMAP (p2) ||
+         IMAGE_INSTANCE_GTK_NPIXELS (p1) != IMAGE_INSTANCE_GTK_NPIXELS (p2))
+       return 0;
+#if HAVE_SUBWINDOWS
+    case IMAGE_SUBWINDOW:
+      /* #### implement me */
+#endif
+      break;
+    default:
+      break;
+    }
+
+  return 1;
+}
+
+static unsigned long
+gtk_image_instance_hash (struct Lisp_Image_Instance *p, int depth)
+{
+  switch (IMAGE_INSTANCE_TYPE (p))
+    {
+    case IMAGE_MONO_PIXMAP:
+    case IMAGE_COLOR_PIXMAP:
+    case IMAGE_POINTER:
+      return IMAGE_INSTANCE_GTK_NPIXELS (p);
+#if HAVE_SUBWINDOWS
+    case IMAGE_SUBWINDOW:
+      /* #### implement me */
+      return 0;
+#endif
+    default:
+      return 0;
+    }
+}
+
+/* Set all the slots in an image instance structure to reasonable
+   default values.  This is used somewhere within an instantiate
+   method.  It is assumed that the device slot within the image
+   instance is already set -- this is the case when instantiate
+   methods are called. */
+
+static void
+gtk_initialize_pixmap_image_instance (struct Lisp_Image_Instance *ii,
+                                     int slices,
+                                     enum image_instance_type type)
+{
+  ii->data = xnew_and_zero (struct gtk_image_instance_data);
+  IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii) = slices;
+  IMAGE_INSTANCE_GTK_PIXMAP_SLICES (ii) =
+    xnew_array_and_zero (GdkPixmap *, slices);
+  IMAGE_INSTANCE_TYPE (ii) = type;
+  IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = Qnil;
+  IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (ii) = Qnil;
+  IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) = Qnil;
+  IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) = Qnil;
+  IMAGE_INSTANCE_PIXMAP_FG (ii) = Qnil;
+  IMAGE_INSTANCE_PIXMAP_BG (ii) = Qnil;
+}
+
+\f
+/************************************************************************/
+/*                        pixmap file functions                         */
+/************************************************************************/
+
+/* Where bitmaps are; initialized from resource database */
+Lisp_Object Vgtk_bitmap_file_path;
+
+#ifndef BITMAPDIR
+#define BITMAPDIR "/usr/include/X11/bitmaps"
+#endif
+
+/* Given a pixmap filename, look through all of the "standard" places
+   where the file might be located.  Return a full pathname if found;
+   otherwise, return Qnil. */
+
+static Lisp_Object
+gtk_locate_pixmap_file (Lisp_Object name)
+{
+  /* This function can GC if IN_REDISPLAY is false */
+
+  /* Check non-absolute pathnames with a directory component relative to
+     the search path; that's the way Xt does it. */
+  /* #### Unix-specific */
+  if (XSTRING_BYTE (name, 0) == '/' ||
+      (XSTRING_BYTE (name, 0) == '.' &&
+       (XSTRING_BYTE (name, 1) == '/' ||
+       (XSTRING_BYTE (name, 1) == '.' &&
+        (XSTRING_BYTE (name, 2) == '/')))))
+    {
+      if (!NILP (Ffile_readable_p (name)))
+       return name;
+      else
+       return Qnil;
+    }
+
+  if (NILP (Vdefault_gtk_device))
+    /* This may occur during intialization. */
+    return Qnil;
+
+  if (NILP (Vgtk_bitmap_file_path))
+    {
+      Vgtk_bitmap_file_path = nconc2 (Vgtk_bitmap_file_path,
+                                     (decode_path (BITMAPDIR)));
+    }
+
+  {
+    Lisp_Object found;
+    if (locate_file (Vgtk_bitmap_file_path, name, Qnil, &found, R_OK) < 0)
+      {
+       Lisp_Object temp = list1 (Vdata_directory);
+       struct gcpro gcpro1;
+
+       GCPRO1 (temp);
+       locate_file (temp, name, Qnil, &found, R_OK);
+       UNGCPRO;
+      }
+
+    return found;
+  }
+}
+
+static Lisp_Object
+locate_pixmap_file (Lisp_Object name)
+{
+  return gtk_locate_pixmap_file (name);
+}
+
+\f
+/************************************************************************/
+/*                           cursor functions                           */
+/************************************************************************/
+
+/* Check that this server supports cursors of size WIDTH * HEIGHT.  If
+   not, signal an error.  INSTANTIATOR is only used in the error
+   message. */
+
+static void
+check_pointer_sizes (unsigned int width, unsigned int height,
+                    Lisp_Object instantiator)
+{
+    /* #### BILL!!! There is no way to call XQueryBestCursor from Gdk! */
+#if 0
+  unsigned int best_width, best_height;
+  if (! XQueryBestCursor (DisplayOfScreen (xs), RootWindowOfScreen (xs),
+                         width, height, &best_width, &best_height))
+    /* this means that an X error of some sort occurred (we trap
+       these so they're not fatal). */
+    signal_simple_error ("XQueryBestCursor() failed?", instantiator);
+
+  if (width > best_width || height > best_height)
+    error_with_frob (instantiator,
+                    "pointer too large (%dx%d): "
+                    "server requires %dx%d or smaller",
+                    width, height, best_width, best_height);
+#endif
+}
+
+static void
+generate_cursor_fg_bg (Lisp_Object device, Lisp_Object *foreground,
+                      Lisp_Object *background, GdkColor *xfg, GdkColor *xbg)
+{
+  if (!NILP (*foreground) && !COLOR_INSTANCEP (*foreground))
+    *foreground =
+      Fmake_color_instance (*foreground, device,
+                           encode_error_behavior_flag (ERROR_ME));
+  if (COLOR_INSTANCEP (*foreground))
+    *xfg = * COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (*foreground));
+  else
+    {
+      xfg->pixel = 0;
+      xfg->red = xfg->green = xfg->blue = 0;
+    }
+
+  if (!NILP (*background) && !COLOR_INSTANCEP (*background))
+    *background =
+      Fmake_color_instance (*background, device,
+                           encode_error_behavior_flag (ERROR_ME));
+  if (COLOR_INSTANCEP (*background))
+    *xbg = * COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (*background));
+  else
+    {
+      xbg->pixel = 0;
+      xbg->red = xbg->green = xbg->blue = ~0;
+    }
+}
+
+static void
+maybe_recolor_cursor (Lisp_Object image_instance, Lisp_Object foreground,
+                     Lisp_Object background)
+{
+#if 0
+    /* #### BILL!!! */
+  Lisp_Object device = XIMAGE_INSTANCE_DEVICE (image_instance);
+  GdkColor xfg, xbg;
+
+  generate_cursor_fg_bg (device, &foreground, &background, &xfg, &xbg);
+  if (!NILP (foreground) || !NILP (background))
+    {
+      XRecolorCursor (DEVICE_X_DISPLAY (XDEVICE (device)),
+                     XIMAGE_INSTANCE_GTK_CURSOR (image_instance),
+                     &xfg, &xbg);
+      XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
+      XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
+    }
+#else
+  /* stderr_out ("Don't know how to recolor cursors in Gtk!\n"); */
+#endif
+}
+
+\f
+/************************************************************************/
+/*                        color pixmap functions                        */
+/************************************************************************/
+
+/* Initialize an image instance from an XImage.
+
+   DEST_MASK specifies the mask of allowed image types.
+
+   PIXELS and NPIXELS specify an array of pixels that are used in
+   the image.  These need to be kept around for the duration of the
+   image.  When the image instance is freed, XFreeColors() will
+   automatically be called on all the pixels specified here; thus,
+   you should have allocated the pixels yourself using XAllocColor()
+   or the like.  The array passed in is used directly without
+   being copied, so it should be heap data created with xmalloc().
+   It will be freed using xfree() when the image instance is
+   destroyed.
+
+   If this fails, signal an error.  INSTANTIATOR is only used
+   in the error message.
+
+   #### This should be able to handle conversion into `pointer'.
+   Use the same code as for `xpm'. */
+
+static void
+init_image_instance_from_gdk_image (struct Lisp_Image_Instance *ii,
+                                   GdkImage *gdk_image,
+                                   int dest_mask,
+                                   GdkColormap *cmap,
+                                   unsigned long *pixels,
+                                   int npixels,
+                                   int slices,
+                                   Lisp_Object instantiator)
+{
+  Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
+  GdkGC *gc;
+  GdkWindow *d;
+  GdkPixmap *pixmap;
+
+  if (!DEVICE_GTK_P (XDEVICE (device)))
+    signal_simple_error ("Not a Gtk device", device);
+
+  d = GET_GTK_WIDGET_WINDOW (DEVICE_GTK_APP_SHELL (XDEVICE (device)));
+
+  if (!(dest_mask & IMAGE_COLOR_PIXMAP_MASK))
+    incompatible_image_types (instantiator, dest_mask,
+                             IMAGE_COLOR_PIXMAP_MASK);
+
+  pixmap = gdk_pixmap_new (d, gdk_image->width, gdk_image->height, gdk_image->depth);
+  if (!pixmap)
+    signal_simple_error ("Unable to create pixmap", instantiator);
+
+  gc = gdk_gc_new (pixmap);
+  if (!gc)
+    {
+      gdk_pixmap_unref (pixmap);
+      signal_simple_error ("Unable to create GC", instantiator);
+    }
+
+  gdk_draw_image (GDK_DRAWABLE (pixmap), gc, gdk_image,
+                 0, 0, 0, 0, gdk_image->width, gdk_image->height);
+
+  gdk_gc_destroy (gc);
+
+  gtk_initialize_pixmap_image_instance (ii, slices, IMAGE_COLOR_PIXMAP);
+
+  IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
+    find_keyword_in_vector (instantiator, Q_file);
+
+  IMAGE_INSTANCE_GTK_PIXMAP (ii) = pixmap;
+  IMAGE_INSTANCE_GTK_MASK (ii) = 0;
+  IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = gdk_image->width;
+  IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = gdk_image->height;
+  IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = gdk_image->depth;
+  IMAGE_INSTANCE_GTK_COLORMAP (ii) = cmap;
+  IMAGE_INSTANCE_GTK_PIXELS (ii) = pixels;
+  IMAGE_INSTANCE_GTK_NPIXELS (ii) = npixels;
+}
+
+#if 0
+void init_image_instance_from_gdk_pixmap (struct Lisp_Image_Instance *ii,
+                                         struct device *device,
+                                         GdkPixmap *gdk_pixmap,
+                                         int dest_mask,
+                                         Lisp_Object instantiator)
+{
+  GdkWindow *d;
+  gint width, height, depth;
+
+  if (!DEVICE_GTK_P (device))
+    abort ();
+
+  IMAGE_INSTANCE_DEVICE (ii) = device;
+  IMAGE_INSTANCE_TYPE (ii) = IMAGE_COLOR_PIXMAP;
+
+  d = GET_GTK_WIDGET_WINDOW (DEVICE_GTK_APP_SHELL (device));
+
+  if (!(dest_mask & IMAGE_COLOR_PIXMAP_MASK))
+    incompatible_image_types (instantiator, dest_mask,
+                             IMAGE_COLOR_PIXMAP_MASK);
+
+  gtk_initialize_pixmap_image_instance (ii, IMAGE_COLOR_PIXMAP);
+
+  gdk_window_get_geometry (gdk_pixmap, NULL, NULL, &width, &height, &depth);
+
+  IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = Qnil;
+  IMAGE_INSTANCE_GTK_PIXMAP (ii) = gdk_pixmap;
+  IMAGE_INSTANCE_GTK_MASK (ii) = 0;
+  IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = width;
+  IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = height;
+  IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = depth;
+  IMAGE_INSTANCE_GTK_COLORMAP (ii) = gdk_window_get_colormap (gdk_pixmap);
+  IMAGE_INSTANCE_GTK_PIXELS (ii) = 0;
+  IMAGE_INSTANCE_GTK_NPIXELS (ii) = 0;
+}
+#endif
+
+static void
+image_instance_add_gdk_image (Lisp_Image_Instance *ii,
+                             GdkImage *gdk_image,
+                             int slice,
+                             Lisp_Object instantiator)
+{
+  Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
+  GdkWindow *d;
+  GdkPixmap *pixmap;
+  GdkGC *gc;
+
+  d = GET_GTK_WIDGET_WINDOW (DEVICE_GTK_APP_SHELL (XDEVICE (device)));
+
+  pixmap = gdk_pixmap_new (d, gdk_image->width, gdk_image->height, gdk_image->depth);
+
+  if (!pixmap)
+    signal_simple_error ("Unable to create pixmap", instantiator);
+
+  gc = gdk_gc_new (pixmap);
+
+  if (!gc)
+    {
+      gdk_pixmap_unref (pixmap);
+      signal_simple_error ("Unable to create GC", instantiator);
+    }
+
+  gdk_draw_image (GDK_DRAWABLE (pixmap), gc, gdk_image, 0, 0, 0, 0,
+                 gdk_image->width, gdk_image->height);
+
+  gdk_gc_destroy (gc);
+
+  IMAGE_INSTANCE_GTK_PIXMAP_SLICE (ii, slice) = pixmap;
+}
+
+static void
+gtk_init_image_instance_from_eimage (struct Lisp_Image_Instance *ii,
+                                    int width, int height,
+                                    int slices,
+                                    unsigned char *eimage, 
+                                    int dest_mask,
+                                    Lisp_Object instantiator,
+                                    Lisp_Object domain)
+{
+  Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
+  GdkColormap *cmap = DEVICE_GTK_COLORMAP (XDEVICE(device));
+  unsigned long *pixtbl = NULL;
+  int npixels = 0;
+  int slice;
+  GdkImage* gdk_image;
+
+
+  for (slice = 0; slice < slices; slice++)
+    {
+      gdk_image = convert_EImage_to_GDKImage (device, width, height, eimage,
+                                             &pixtbl, &npixels);
+      if (!gdk_image)
+       {
+         if (pixtbl) xfree (pixtbl);
+         signal_image_error("EImage to GdkImage conversion failed", instantiator);
+       }
+
+      if (slice == 0)
+       /* Now create the pixmap and set up the image instance */
+       init_image_instance_from_gdk_image (ii, gdk_image, dest_mask,
+                                           cmap, pixtbl, npixels, slices,
+                                           instantiator);
+      else
+       image_instance_add_gdk_image (ii, gdk_image, slice, instantiator);
+
+      if (gdk_image)
+       {
+         gdk_image_destroy (gdk_image);
+       }
+      gdk_image = 0;
+    }
+}
+
+/* Given inline data for a mono pixmap, create and return the
+   corresponding X object. */
+
+static GdkPixmap *
+pixmap_from_xbm_inline (Lisp_Object device, int width, int height,
+                       /* Note that data is in ext-format! */
+                       CONST Extbyte *bits)
+{
+    return (gdk_bitmap_create_from_data (GET_GTK_WIDGET_WINDOW (DEVICE_GTK_APP_SHELL (XDEVICE (device))),
+                                        (char *) bits, width, height));
+}
+
+/* Given inline data for a mono pixmap, initialize the given
+   image instance accordingly. */
+
+static void
+init_image_instance_from_xbm_inline (struct Lisp_Image_Instance *ii,
+                                    int width, int height,
+                                    /* Note that data is in ext-format! */
+                                    CONST char *bits,
+                                    Lisp_Object instantiator,
+                                    Lisp_Object pointer_fg,
+                                    Lisp_Object pointer_bg,
+                                    int dest_mask,
+                                    GdkPixmap *mask,
+                                    Lisp_Object mask_filename)
+{
+  Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
+  Lisp_Object foreground = find_keyword_in_vector (instantiator, Q_foreground);
+  Lisp_Object background = find_keyword_in_vector (instantiator, Q_background);
+  GdkColor fg;
+  GdkColor bg;
+  enum image_instance_type type;
+  GdkWindow *draw = GET_GTK_WIDGET_WINDOW (DEVICE_GTK_APP_SHELL (XDEVICE (device)));
+  GdkColormap *cmap = DEVICE_GTK_COLORMAP (XDEVICE(device));
+  GdkColor black;
+  GdkColor white;
+
+  gdk_color_black(cmap, &black);
+  gdk_color_white(cmap, &white);
+
+  if (!DEVICE_GTK_P (XDEVICE (device)))
+    signal_simple_error ("Not a Gtk device", device);
+
+  if ((dest_mask & IMAGE_MONO_PIXMAP_MASK) &&
+      (dest_mask & IMAGE_COLOR_PIXMAP_MASK))
+    {
+      if (!NILP (foreground) || !NILP (background))
+       type = IMAGE_COLOR_PIXMAP;
+      else
+       type = IMAGE_MONO_PIXMAP;
+    }
+  else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
+    type = IMAGE_MONO_PIXMAP;
+  else if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
+    type = IMAGE_COLOR_PIXMAP;
+  else if (dest_mask & IMAGE_POINTER_MASK)
+    type = IMAGE_POINTER;
+  else
+    incompatible_image_types (instantiator, dest_mask,
+                             IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
+                             | IMAGE_POINTER_MASK);
+
+  gtk_initialize_pixmap_image_instance (ii, 1, type);
+  IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = width;
+  IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = height;
+  IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
+    find_keyword_in_vector (instantiator, Q_file);
+
+  switch (type)
+    {
+    case IMAGE_MONO_PIXMAP:
+      {
+       IMAGE_INSTANCE_GTK_PIXMAP (ii) =
+         pixmap_from_xbm_inline (device, width, height, (Extbyte *) bits);
+      }
+      break;
+
+    case IMAGE_COLOR_PIXMAP:
+      {
+       gint d = DEVICE_GTK_DEPTH (XDEVICE(device));
+
+       if (!NILP (foreground) && !COLOR_INSTANCEP (foreground))
+         foreground =
+           Fmake_color_instance (foreground, device,
+                                 encode_error_behavior_flag (ERROR_ME));
+
+       if (COLOR_INSTANCEP (foreground))
+         fg = * COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (foreground));
+
+       if (!NILP (background) && !COLOR_INSTANCEP (background))
+         background =
+           Fmake_color_instance (background, device,
+                                 encode_error_behavior_flag (ERROR_ME));
+
+       if (COLOR_INSTANCEP (background))
+         bg = * COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (background));
+
+       /* We used to duplicate the pixels using XAllocColor(), to protect
+          against their getting freed.  Just as easy to just store the
+          color instances here and GC-protect them, so this doesn't
+          happen. */
+       IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
+       IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
+       IMAGE_INSTANCE_GTK_PIXMAP (ii) =
+           gdk_pixmap_create_from_data (draw, (char *) bits, width, height, d, &fg, &bg);
+       IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = d;
+      }
+      break;
+
+    case IMAGE_POINTER:
+    {
+       GdkColor fg_color, bg_color;
+       GdkPixmap *source;
+
+       check_pointer_sizes (width, height, instantiator);
+
+       source = gdk_pixmap_create_from_data (draw, (char *) bits, width, height, 1, &black, &white);
+
+       if (NILP (foreground))
+         foreground = pointer_fg;
+       if (NILP (background))
+         background = pointer_bg;
+       generate_cursor_fg_bg (device, &foreground, &background,
+                              &fg_color, &bg_color);
+
+       IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
+       IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
+       IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) =
+         find_keyword_in_vector (instantiator, Q_hotspot_x);
+       IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) =
+         find_keyword_in_vector (instantiator, Q_hotspot_y);
+       IMAGE_INSTANCE_GTK_CURSOR (ii) =
+           gdk_cursor_new_from_pixmap (source, mask, &fg_color, &bg_color,
+                                       !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ?
+                                       XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) : 0,
+                                       !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) ?
+                                       XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) : 0);
+      }
+      break;
+
+    default:
+      abort ();
+    }
+}
+
+static void
+xbm_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator,
+                  Lisp_Object pointer_fg, Lisp_Object pointer_bg,
+                  int dest_mask, int width, int height,
+                  /* Note that data is in ext-format! */
+                  CONST char *bits)
+{
+  Lisp_Object mask_data = find_keyword_in_vector (instantiator, Q_mask_data);
+  Lisp_Object mask_file = find_keyword_in_vector (instantiator, Q_mask_file);
+  struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+  GdkPixmap *mask = 0;
+  CONST char *gcc_may_you_rot_in_hell;
+
+  if (!NILP (mask_data))
+    {
+      TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (XCDR (XCDR (mask_data))),
+                         C_STRING_ALLOCA, gcc_may_you_rot_in_hell,
+                         Qfile_name);
+      mask =
+       pixmap_from_xbm_inline (IMAGE_INSTANCE_DEVICE (ii),
+                               XINT (XCAR (mask_data)),
+                               XINT (XCAR (XCDR (mask_data))),
+                               (CONST unsigned char *)
+                               gcc_may_you_rot_in_hell);
+    }
+
+  init_image_instance_from_xbm_inline (ii, width, height, bits,
+                                      instantiator, pointer_fg, pointer_bg,
+                                      dest_mask, mask, mask_file);
+}
+
+/* Instantiate method for XBM's. */
+
+static void
+gtk_xbm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
+                    Lisp_Object pointer_fg, Lisp_Object pointer_bg,
+                    int dest_mask, Lisp_Object domain)
+{
+  Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
+  CONST char *gcc_go_home;
+
+  assert (!NILP (data));
+
+  TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (XCDR (XCDR (data))),
+                     C_STRING_ALLOCA, gcc_go_home,
+                     Qbinary);
+
+  xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
+                    pointer_bg, dest_mask, XINT (XCAR (data)),
+                    XINT (XCAR (XCDR (data))), gcc_go_home);
+}
+
+\f
+#ifdef HAVE_XPM
+/**********************************************************************
+ *                             XPM                                    *
+ **********************************************************************/
+static void
+write_lisp_string_to_temp_file (Lisp_Object string, char *filename_out)
+{
+  Lisp_Object instream, outstream;
+  Lstream *istr, *ostr;
+  char tempbuf[1024]; /* some random amount */
+  int fubar = 0;
+  FILE *tmpfil;
+  static Extbyte_dynarr *conversion_out_dynarr;
+  Bytecount bstart, bend;
+  struct gcpro gcpro1, gcpro2;
+#ifdef FILE_CODING
+  Lisp_Object conv_out_stream;
+  Lstream *costr;
+  struct gcpro gcpro3;
+#endif
+
+  /* This function can GC */
+  if (!conversion_out_dynarr)
+    conversion_out_dynarr = Dynarr_new (Extbyte);
+  else
+    Dynarr_reset (conversion_out_dynarr);
+
+  /* Create the temporary file ... */
+  sprintf (filename_out, "/tmp/emacs%d.XXXXXX", (int) getpid ());
+  mktemp (filename_out);
+  tmpfil = fopen (filename_out, "w");
+  if (!tmpfil)
+    {
+      if (tmpfil)
+       {
+         int old_errno = errno;
+         fclose (tmpfil);
+         unlink (filename_out);
+         errno = old_errno;
+       }
+      report_file_error ("Creating temp file",
+                        list1 (build_string (filename_out)));
+    }
+
+  CHECK_STRING (string);
+  get_string_range_byte (string, Qnil, Qnil, &bstart, &bend,
+                        GB_HISTORICAL_STRING_BEHAVIOR);
+  instream = make_lisp_string_input_stream (string, bstart, bend);
+  istr = XLSTREAM (instream);
+  /* setup the out stream */
+  outstream = make_dynarr_output_stream((unsigned_char_dynarr *)conversion_out_dynarr);
+  ostr = XLSTREAM (outstream);
+#ifdef FILE_CODING
+  /* setup the conversion stream */
+  conv_out_stream = make_encoding_output_stream (ostr, Fget_coding_system(Qbinary));
+  costr = XLSTREAM (conv_out_stream);
+  GCPRO3 (instream, outstream, conv_out_stream);
+#else
+  GCPRO2 (instream, outstream);
+#endif
+
+  /* Get the data while doing the conversion */
+  while (1)
+    {
+      int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
+      if (!size_in_bytes)
+       break;
+      /* It does seem the flushes are necessary... */
+#ifdef FILE_CODING
+      Lstream_write (costr, tempbuf, size_in_bytes);
+      Lstream_flush (costr);
+#else
+      Lstream_write (ostr, tempbuf, size_in_bytes);
+#endif
+      Lstream_flush (ostr);
+      if (fwrite ((unsigned char *)Dynarr_atp(conversion_out_dynarr, 0),
+                 Dynarr_length(conversion_out_dynarr), 1, tmpfil) != 1)
+       {
+         fubar = 1;
+         break;
+       }
+      /* reset the dynarr */
+      Lstream_rewind(ostr);
+    }
+  
+  if (fclose (tmpfil) != 0)
+    fubar = 1;
+  Lstream_close (istr);
+#ifdef FILE_CODING
+  Lstream_close (costr);
+#endif
+  Lstream_close (ostr);
+
+  UNGCPRO;
+  Lstream_delete (istr);
+  Lstream_delete (ostr);
+#ifdef FILE_CODING
+  Lstream_delete (costr);
+#endif
+
+  if (fubar)
+    report_file_error ("Writing temp file",
+                      list1 (build_string (filename_out)));
+}
+
+struct color_symbol
+{
+  char*                name;
+  GdkColor     color;
+};
+
+static struct color_symbol*
+extract_xpm_color_names (Lisp_Object device,
+                        Lisp_Object domain,
+                        Lisp_Object color_symbol_alist,
+                        int* nsymbols)
+{
+  /* This function can GC */
+  Lisp_Object rest;
+  Lisp_Object results = Qnil;
+  int i, j;
+  struct color_symbol *colortbl;
+  struct gcpro gcpro1, gcpro2;
+
+  GCPRO2 (results, device);
+
+  /* We built up results to be (("name" . #<color>) ...) so that if an
+     error happens we don't lose any malloc()ed data, or more importantly,
+     leave any pixels allocated in the server. */
+  i = 0;
+  LIST_LOOP (rest, color_symbol_alist)
+    {
+      Lisp_Object cons = XCAR (rest);
+      Lisp_Object name = XCAR (cons);
+      Lisp_Object value = XCDR (cons);
+      if (NILP (value))
+       continue;
+      if (STRINGP (value))
+       value =
+         Fmake_color_instance
+         (value, device, encode_error_behavior_flag (ERROR_ME_NOT));
+      else
+        {
+          assert (COLOR_SPECIFIERP (value));
+          value = Fspecifier_instance (value, domain, Qnil, Qnil);
+        }
+      if (NILP (value))
+        continue;
+      results = noseeum_cons (noseeum_cons (name, value), results);
+      i++;
+    }
+  UNGCPRO;                     /* no more evaluation */
+
+  *nsymbols=i;
+  if (i == 0) return 0;
+
+  colortbl = xnew_array_and_zero (struct color_symbol, i);
+
+  for (j=0; j<i; j++)
+    {
+      Lisp_Object cons = XCAR (results);
+      colortbl[j].color = 
+       * COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (XCDR (cons)));
+
+      colortbl[j].name = (char *) XSTRING_DATA (XCAR (cons));
+      free_cons (XCONS (cons));
+      cons = results;
+      results = XCDR (results);
+      free_cons (XCONS (cons));
+    }
+  return colortbl;
+}
+
+static void
+gtk_xpm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
+                    Lisp_Object pointer_fg, Lisp_Object pointer_bg,
+                    int dest_mask, Lisp_Object domain)
+{
+  /* This function can GC */
+  char temp_file_name[1024];
+  struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+  Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
+  Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
+  GdkColormap *cmap;
+  int depth;
+  GdkVisual *visual;
+  GdkPixmap *pixmap;
+  GdkPixmap *mask = 0;
+  GdkWindow *window = 0;
+  int nsymbols = 0, i = 0;
+  struct color_symbol *color_symbols = NULL;
+  GdkColor *transparent_color = NULL;
+  Lisp_Object color_symbol_alist = find_keyword_in_vector (instantiator,
+                                                          Q_color_symbols);
+  enum image_instance_type type;
+  int force_mono;
+  unsigned int w, h;
+
+  if (!DEVICE_GTK_P (XDEVICE (device)))
+    signal_simple_error ("Not a Gtk device", device);
+
+  if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
+    type = IMAGE_COLOR_PIXMAP;
+  else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
+    type = IMAGE_MONO_PIXMAP;
+  else if (dest_mask & IMAGE_POINTER_MASK)
+    type = IMAGE_POINTER;
+  else
+    incompatible_image_types (instantiator, dest_mask,
+                             IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
+                             | IMAGE_POINTER_MASK);
+  force_mono = (type != IMAGE_COLOR_PIXMAP);
+
+  window = GET_GTK_WIDGET_WINDOW (DEVICE_GTK_APP_SHELL (XDEVICE (device)));
+  cmap = DEVICE_GTK_COLORMAP (XDEVICE (device));
+  depth = DEVICE_GTK_DEPTH (XDEVICE (device));
+  visual = DEVICE_GTK_VISUAL (XDEVICE (device));
+
+  gtk_initialize_pixmap_image_instance (ii, 1, type);
+
+  assert (!NILP (data));
+
+  /* Need to get the transparent color here */
+  color_symbols = extract_xpm_color_names (device, domain, color_symbol_alist, &nsymbols);
+  for (i = 0; i < nsymbols; i++)
+    {
+      if (!strcasecmp ("BgColor", color_symbols[i].name) ||
+         !strcasecmp ("None", color_symbols[i].name))
+       {
+         transparent_color = &color_symbols[i].color;
+       }
+    }
+
+  write_lisp_string_to_temp_file (data, temp_file_name);
+  pixmap = gdk_pixmap_create_from_xpm (window, &mask, transparent_color, temp_file_name);
+  unlink (temp_file_name);
+
+  if (color_symbols) xfree (color_symbols);
+
+  if (!pixmap)
+  {
+    signal_image_error ("Error reading pixmap", data);
+  }
+
+  gdk_window_get_geometry (pixmap, NULL, NULL, &w, &h, &depth);
+
+  IMAGE_INSTANCE_GTK_PIXMAP (ii) = pixmap;
+  IMAGE_INSTANCE_GTK_MASK (ii) = mask;
+  IMAGE_INSTANCE_GTK_COLORMAP (ii) = cmap;
+  IMAGE_INSTANCE_GTK_PIXELS (ii) = 0;
+  IMAGE_INSTANCE_GTK_NPIXELS (ii) = 0;
+  IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = w;
+  IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = h;
+  IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
+    find_keyword_in_vector (instantiator, Q_file);
+
+  switch (type)
+    {
+    case IMAGE_MONO_PIXMAP:
+      break;
+
+    case IMAGE_COLOR_PIXMAP:
+      {
+       IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = depth;
+      }
+      break;
+
+    case IMAGE_POINTER:
+      {
+       GdkColor fg, bg;
+       unsigned int xhot, yhot;
+
+       /* #### Gtk does not give us access to the hotspots of a pixmap */
+       xhot = yhot = 1;
+       XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii), xhot);
+       XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii), yhot);
+
+       check_pointer_sizes (w, h, instantiator);
+
+       /* If the loaded pixmap has colors allocated (meaning it came from an
+          XPM file), then use those as the default colors for the cursor we
+          create.  Otherwise, default to pointer_fg and pointer_bg.
+       */
+       if (depth > 1)
+         {
+           warn_when_safe (Qunimplemented, Qnotice,
+                           "GTK does not support XPM cursors...\n");
+           IMAGE_INSTANCE_GTK_CURSOR (ii) = gdk_cursor_new (GDK_COFFEE_MUG);
+         }
+       else
+         {
+           generate_cursor_fg_bg (device, &pointer_fg, &pointer_bg,
+                                  &fg, &bg);
+           IMAGE_INSTANCE_PIXMAP_FG (ii) = pointer_fg;
+           IMAGE_INSTANCE_PIXMAP_BG (ii) = pointer_bg;
+           IMAGE_INSTANCE_GTK_CURSOR (ii) = gdk_cursor_new_from_pixmap (pixmap, mask, &fg, &bg, xhot, yhot);
+         }
+      }
+
+      break;
+
+    default:
+      abort ();
+    }
+}
+#endif /* HAVE_XPM */
+
+\f
+#ifdef HAVE_XFACE
+
+/**********************************************************************
+ *                             X-Face                                 *
+ **********************************************************************/
+#if defined(EXTERN)
+/* This is about to get redefined! */
+#undef EXTERN
+#endif
+/* We have to define SYSV32 so that compface.h includes string.h
+   instead of strings.h. */
+#define SYSV32
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include <compface.h>
+#ifdef __cplusplus
+}
+#endif
+/* JMP_BUF cannot be used here because if it doesn't get defined
+   to jmp_buf we end up with a conflicting type error with the
+   definition in compface.h */
+extern jmp_buf comp_env;
+#undef SYSV32
+
+static void
+gtk_xface_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
+                  Lisp_Object pointer_fg, Lisp_Object pointer_bg,
+                  int dest_mask, Lisp_Object domain)
+{
+  Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
+  int i, stattis;
+  char *p, *bits, *bp;
+  CONST char * volatile emsg = 0;
+  CONST char * volatile dstring;
+
+  assert (!NILP (data));
+
+  LISP_STRING_TO_EXTERNAL (data, dstring, Qbinary);
+
+  if ((p = strchr (dstring, ':')))
+    {
+      dstring = p + 1;
+    }
+
+  /* Must use setjmp not SETJMP because we used jmp_buf above not JMP_BUF */
+  if (!(stattis = setjmp (comp_env)))
+    {
+      UnCompAll ((char *) dstring);
+      UnGenFace ();
+    }
+
+  switch (stattis)
+    {
+    case -2:
+      emsg = "uncompface: internal error";
+      break;
+    case -1:
+      emsg = "uncompface: insufficient or invalid data";
+      break;
+    case 1:
+      emsg = "uncompface: excess data ignored";
+      break;
+    }
+
+  if (emsg)
+    signal_simple_error_2 (emsg, data, Qimage);
+
+  bp = bits = (char *) alloca (PIXELS / 8);
+
+  /* the compface library exports char F[], which uses a single byte per
+     pixel to represent a 48x48 bitmap.  Yuck. */
+  for (i = 0, p = F; i < (PIXELS / 8); ++i)
+    {
+      int n, b;
+      /* reverse the bit order of each byte... */
+      for (b = n = 0; b < 8; ++b)
+       {
+         n |= ((*p++) << b);
+       }
+      *bp++ = (char) n;
+    }
+
+  xbm_instantiate_1 (image_instance, instantiator, pointer_fg,
+                    pointer_bg, dest_mask, 48, 48, bits);
+}
+
+#endif /* HAVE_XFACE */
+
+/**********************************************************************
+ *                             RESOURCES                              *
+ **********************************************************************/
+
+static void
+gtk_resource_validate (Lisp_Object instantiator)
+{
+  if ((NILP (find_keyword_in_vector (instantiator, Q_file)) 
+       &&
+       NILP (find_keyword_in_vector (instantiator, Q_resource_id))) 
+      ||
+      NILP (find_keyword_in_vector (instantiator, Q_resource_type)))
+    signal_simple_error ("Must supply :file, :resource-id and :resource-type",
+                        instantiator);
+}
+
+static Lisp_Object
+gtk_resource_normalize (Lisp_Object inst, Lisp_Object console_type, Lisp_Object dest_mask)
+{
+  /* This function can call lisp */
+  Lisp_Object file = Qnil;
+  struct gcpro gcpro1, gcpro2;
+  Lisp_Object alist = Qnil;
+
+  GCPRO2 (file, alist);
+
+  file = potential_pixmap_file_instantiator (inst, Q_file, Q_data, 
+                                            console_type);
+
+  if (CONSP (file)) /* failure locating filename */
+    signal_double_file_error ("Opening pixmap file",
+                             "no such file or directory",
+                             Fcar (file));
+
+  if (NILP (file)) /* no conversion necessary */
+    RETURN_UNGCPRO (inst);
+
+  alist = tagged_vector_to_alist (inst);
+
+  {
+    alist = remassq_no_quit (Q_file, alist);
+    alist = Fcons (Fcons (Q_file, file), alist);
+  }
+
+  {
+    Lisp_Object result = alist_to_tagged_vector (Qgtk_resource, alist);
+    free_alist (alist);
+    RETURN_UNGCPRO (result);
+  }
+}
+
+static int
+gtk_resource_possible_dest_types (void)
+{
+  return IMAGE_POINTER_MASK | IMAGE_COLOR_PIXMAP_MASK;
+}
+
+extern guint symbol_to_enum (Lisp_Object, GtkType);
+
+static guint resource_name_to_resource (Lisp_Object name, int type)
+{
+  if (type == IMAGE_POINTER)
+    return (symbol_to_enum (name, GTK_TYPE_GDK_CURSOR_TYPE));
+  else
+    return (0);
+}
+
+static int
+resource_symbol_to_type (Lisp_Object data)
+{
+  if (EQ (data, Qcursor))
+    return IMAGE_POINTER;
+#if 0
+  else if (EQ (data, Qicon))
+    return IMAGE_ICON;
+  else if (EQ (data, Qbitmap))
+    return IMAGE_BITMAP;
+#endif
+  else
+    return 0;
+}
+
+static void
+gtk_resource_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
+                         Lisp_Object pointer_fg, Lisp_Object pointer_bg,
+                         int dest_mask, Lisp_Object domain)
+{
+  struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+  GdkCursor *c = NULL;
+  unsigned int type = 0;
+  Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
+  Lisp_Object resource_type = find_keyword_in_vector (instantiator, Q_resource_type);
+  Lisp_Object resource_id = find_keyword_in_vector (instantiator, Q_resource_id);
+
+  if (!DEVICE_GTK_P (XDEVICE (device)))
+    signal_simple_error ("Not a GTK device", device);
+
+  type = resource_symbol_to_type (resource_type);
+
+  //   if (dest_mask & IMAGE_POINTER_MASK && type == IMAGE_POINTER_MASK)
+  //     iitype = IMAGE_POINTER;
+  //   else if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
+  //     iitype = IMAGE_COLOR_PIXMAP;
+  //   else 
+  //     incompatible_image_types (instantiator, dest_mask,
+  //                         IMAGE_COLOR_PIXMAP_MASK | IMAGE_POINTER_MASK);
+
+  /* mess with the keyword info we were provided with */
+  gtk_initialize_pixmap_image_instance (ii, 1, type);
+  c = gdk_cursor_new (resource_name_to_resource (resource_id, type));
+  IMAGE_INSTANCE_GTK_CURSOR (ii) = c;
+  IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = resource_id;
+  IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = 10;
+  IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = 10;
+  IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = 1;
+}
+
+static void
+check_valid_resource_symbol (Lisp_Object data)
+{
+  CHECK_SYMBOL (data);
+  if (!resource_symbol_to_type (data))
+    signal_simple_error ("invalid resource type", data);
+}
+
+static void
+check_valid_resource_id (Lisp_Object data)
+{
+  if (!resource_name_to_resource (data, IMAGE_POINTER)
+      &&
+      !resource_name_to_resource (data, IMAGE_COLOR_PIXMAP)
+#if 0
+      &&
+      !resource_name_to_resource (data, IMAGE_BITMAP)
+#endif
+      )
+    signal_simple_error ("invalid resource identifier", data);
+}
+
+#if 0
+void
+check_valid_string_or_int (Lisp_Object data)
+{
+  if (!INTP (data))
+    CHECK_STRING (data);
+  else
+    CHECK_INT (data);
+}
+#endif
+
+\f
+/**********************************************************************
+ *                      Autodetect                                      *
+ **********************************************************************/
+
+static void
+autodetect_validate (Lisp_Object instantiator)
+{
+  data_must_be_present (instantiator);
+}
+
+static Lisp_Object
+autodetect_normalize (Lisp_Object instantiator,
+                     Lisp_Object console_type,
+                     Lisp_Object dest_mask)
+{
+  Lisp_Object file = find_keyword_in_vector (instantiator, Q_data);
+  Lisp_Object filename = Qnil;
+  Lisp_Object data = Qnil;
+  struct gcpro gcpro1, gcpro2, gcpro3;
+  Lisp_Object alist = Qnil;
+
+  GCPRO3 (filename, data, alist);
+
+  if (NILP (file)) /* no conversion necessary */
+    RETURN_UNGCPRO (instantiator);
+
+  alist = tagged_vector_to_alist (instantiator);
+
+  filename = locate_pixmap_file (file);
+  if (!NILP (filename))
+    {
+      int xhot, yhot;
+      /* #### Apparently some versions of XpmReadFileToData, which is
+        called by pixmap_to_lisp_data, don't return an error value
+        if the given file is not a valid XPM file.  Instead, they
+        just seg fault.  It is definitely caused by passing a
+        bitmap.  To try and avoid this we check for bitmaps first.  */
+
+      data = bitmap_to_lisp_data (filename, &xhot, &yhot, 1);
+
+      if (!EQ (data, Qt))
+       {
+         alist = remassq_no_quit (Q_data, alist);
+         alist = Fcons (Fcons (Q_file, filename),
+                        Fcons (Fcons (Q_data, data), alist));
+         if (xhot != -1)
+           alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
+                          alist);
+         if (yhot != -1)
+           alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
+                          alist);
+
+         alist = xbm_mask_file_munging (alist, filename, Qnil, console_type);
+
+         {
+           Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
+           free_alist (alist);
+           RETURN_UNGCPRO (result);
+         }
+       }
+
+#ifdef HAVE_XPM
+      data = pixmap_to_lisp_data (filename, 1);
+
+      if (!EQ (data, Qt))
+       {
+         alist = remassq_no_quit (Q_data, alist);
+         alist = Fcons (Fcons (Q_file, filename),
+                        Fcons (Fcons (Q_data, data), alist));
+         alist = Fcons (Fcons (Q_color_symbols,
+                               evaluate_xpm_color_symbols ()),
+                        alist);
+         {
+           Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
+           free_alist (alist);
+           RETURN_UNGCPRO (result);
+         }
+       }
+#endif
+    }
+
+  /* If we couldn't convert it, just put it back as it is.
+     We might try to further frob it later as a cursor-font
+     specification. (We can't do that now because we don't know
+     what dest-types it's going to be instantiated into.) */
+  {
+    Lisp_Object result = alist_to_tagged_vector (Qautodetect, alist);
+    free_alist (alist);
+    RETURN_UNGCPRO (result);
+  }
+}
+
+static int
+autodetect_possible_dest_types (void)
+{
+  return
+    IMAGE_MONO_PIXMAP_MASK  |
+    IMAGE_COLOR_PIXMAP_MASK |
+    IMAGE_POINTER_MASK      |
+    IMAGE_TEXT_MASK;
+}
+
+static void
+autodetect_instantiate (Lisp_Object image_instance,
+                                 Lisp_Object instantiator,
+                                 Lisp_Object pointer_fg,
+                                 Lisp_Object pointer_bg,
+                                 int dest_mask, Lisp_Object domain)
+{
+  Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
+  struct gcpro gcpro1, gcpro2, gcpro3;
+  Lisp_Object alist = Qnil;
+  Lisp_Object result = Qnil;
+  int is_cursor_font = 0;
+
+  GCPRO3 (data, alist, result);
+
+  alist = tagged_vector_to_alist (instantiator);
+  if (dest_mask & IMAGE_POINTER_MASK)
+    {
+      CONST char *name_ext;
+
+      TO_EXTERNAL_FORMAT (LISP_STRING, data,
+                         C_STRING_ALLOCA, name_ext,
+                         Qfile_name);
+
+      if (cursor_name_to_index (name_ext) != -1)
+        {
+          result = alist_to_tagged_vector (Qcursor_font, alist);
+          is_cursor_font = 1;
+        }
+    }
+
+  if (!is_cursor_font)
+    result = alist_to_tagged_vector (Qstring, alist);
+  free_alist (alist);
+
+  if (is_cursor_font)
+    cursor_font_instantiate (image_instance, result, pointer_fg,
+                            pointer_bg, dest_mask, domain);
+  else
+    string_instantiate (image_instance, result, pointer_fg,
+                       pointer_bg, dest_mask, domain);
+
+  UNGCPRO;
+}
+
+\f
+/**********************************************************************
+ *                              Font                                  *
+ **********************************************************************/
+
+static void
+font_validate (Lisp_Object instantiator)
+{
+  data_must_be_present (instantiator);
+}
+
+static int
+font_possible_dest_types (void)
+{
+  return IMAGE_POINTER_MASK;
+}
+
+static void
+font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
+                 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
+                 int dest_mask, Lisp_Object domain)
+{
+  /* This function can GC */
+  Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
+  struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+  Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
+  GdkColor fg, bg;
+  GdkFont *source, *mask;
+  char source_name[MAXPATHLEN], mask_name[MAXPATHLEN], dummy;
+  int source_char, mask_char;
+  int count;
+  Lisp_Object foreground, background;
+
+  if (!DEVICE_GTK_P (XDEVICE (device)))
+    signal_simple_error ("Not a Gtk device", device);
+
+  if (!STRINGP (data) ||
+      strncmp ("FONT ", (char *) XSTRING_DATA (data), 5))
+    signal_simple_error ("Invalid font-glyph instantiator",
+                        instantiator);
+
+  if (!(dest_mask & IMAGE_POINTER_MASK))
+    incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
+
+  foreground = find_keyword_in_vector (instantiator, Q_foreground);
+  if (NILP (foreground))
+    foreground = pointer_fg;
+  background = find_keyword_in_vector (instantiator, Q_background);
+  if (NILP (background))
+    background = pointer_bg;
+
+  generate_cursor_fg_bg (device, &foreground, &background, &fg, &bg);
+
+  count = sscanf ((char *) XSTRING_DATA (data),
+                 "FONT %s %d %s %d %c",
+                 source_name, &source_char,
+                 mask_name, &mask_char, &dummy);
+  /* Allow "%s %d %d" as well... */
+  if (count == 3 && (1 == sscanf (mask_name, "%d %c", &mask_char, &dummy)))
+    count = 4, mask_name[0] = 0;
+
+  if (count != 2 && count != 4)
+    signal_simple_error ("invalid cursor specification", data);
+  source = gdk_font_load (source_name);
+  if (! source)
+    signal_simple_error_2 ("couldn't load font",
+                          build_string (source_name),
+                          data);
+  if (count == 2)
+    mask = 0;
+  else if (!mask_name[0])
+    mask = source;
+  else
+    {
+      mask = gdk_font_load (mask_name);
+      if (!mask)
+       /* continuable */
+       Fsignal (Qerror, list3 (build_string ("couldn't load font"),
+                               build_string (mask_name), data));
+    }
+  if (!mask)
+    mask_char = 0;
+
+  /* #### call XQueryTextExtents() and check_pointer_sizes() here. */
+
+  gtk_initialize_pixmap_image_instance (ii, 1, IMAGE_POINTER);
+
+  IMAGE_INSTANCE_GTK_CURSOR (ii) = NULL;
+
+#if 0
+  /* #### BILL!!! There is no way to call this function from Gdk */
+    XCreateGlyphCursor (dpy, source, mask, source_char, mask_char,
+                       &fg, &bg);
+#endif
+  XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground;
+  XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background;
+
+  gdk_font_unref (source);
+  if (mask && mask != source) gdk_font_unref (mask);
+}
+
+\f
+/**********************************************************************
+ *                           Cursor-Font                              *
+ **********************************************************************/
+
+static void
+cursor_font_validate (Lisp_Object instantiator)
+{
+  data_must_be_present (instantiator);
+}
+
+static int
+cursor_font_possible_dest_types (void)
+{
+  return IMAGE_POINTER_MASK;
+}
+
+static char *__downcase (const char *name)
+{
+    char *converted = strdup(name);
+    char *work = converted;
+
+    while (*work)
+    {
+       *work = tolower(*work);
+       work++;
+    }
+    return(converted);
+}
+
+/* This is basically the equivalent of XmuCursorNameToIndex */
+static gint
+cursor_name_to_index (const char *name)
+{
+    int i;
+    static char *the_gdk_cursors[GDK_NUM_GLYPHS];
+
+    if (!the_gdk_cursors[GDK_BASED_ARROW_UP])
+    {
+       /* Need to initialize the array */
+       /* Supposedly since this array is static it should be
+           initialized to NULLs for us, but I'm very paranoid. */
+       for (i = 0; i < GDK_NUM_GLYPHS; i++)
+       {
+           the_gdk_cursors[i] = NULL;
+       }
+
+#define FROB_CURSOR(x) the_gdk_cursors[GDK_##x] = __downcase(#x)
+       FROB_CURSOR(ARROW);                     FROB_CURSOR(BASED_ARROW_DOWN);
+       FROB_CURSOR(BASED_ARROW_UP);            FROB_CURSOR(BOAT);
+       FROB_CURSOR(BOGOSITY);                  FROB_CURSOR(BOTTOM_LEFT_CORNER);
+       FROB_CURSOR(BOTTOM_RIGHT_CORNER);       FROB_CURSOR(BOTTOM_SIDE);
+       FROB_CURSOR(BOTTOM_TEE);                FROB_CURSOR(BOX_SPIRAL);
+       FROB_CURSOR(CENTER_PTR);                FROB_CURSOR(CIRCLE);
+       FROB_CURSOR(CLOCK);                     FROB_CURSOR(COFFEE_MUG);
+       FROB_CURSOR(CROSS);                     FROB_CURSOR(CROSS_REVERSE);
+       FROB_CURSOR(CROSSHAIR);                 FROB_CURSOR(DIAMOND_CROSS);
+       FROB_CURSOR(DOT);                       FROB_CURSOR(DOTBOX);
+       FROB_CURSOR(DOUBLE_ARROW);              FROB_CURSOR(DRAFT_LARGE);
+       FROB_CURSOR(DRAFT_SMALL);               FROB_CURSOR(DRAPED_BOX);
+       FROB_CURSOR(EXCHANGE);                  FROB_CURSOR(FLEUR);
+       FROB_CURSOR(GOBBLER);                   FROB_CURSOR(GUMBY);
+       FROB_CURSOR(HAND1);                     FROB_CURSOR(HAND2);
+       FROB_CURSOR(HEART);                     FROB_CURSOR(ICON);
+       FROB_CURSOR(IRON_CROSS);                FROB_CURSOR(LEFT_PTR);
+       FROB_CURSOR(LEFT_SIDE);                 FROB_CURSOR(LEFT_TEE);
+       FROB_CURSOR(LEFTBUTTON);                FROB_CURSOR(LL_ANGLE);
+       FROB_CURSOR(LR_ANGLE);                  FROB_CURSOR(MAN);
+       FROB_CURSOR(MIDDLEBUTTON);              FROB_CURSOR(MOUSE);
+       FROB_CURSOR(PENCIL);                    FROB_CURSOR(PIRATE);
+       FROB_CURSOR(PLUS);                      FROB_CURSOR(QUESTION_ARROW);
+       FROB_CURSOR(RIGHT_PTR);                 FROB_CURSOR(RIGHT_SIDE);
+       FROB_CURSOR(RIGHT_TEE);                 FROB_CURSOR(RIGHTBUTTON);
+       FROB_CURSOR(RTL_LOGO);                  FROB_CURSOR(SAILBOAT);
+       FROB_CURSOR(SB_DOWN_ARROW);             FROB_CURSOR(SB_H_DOUBLE_ARROW);
+       FROB_CURSOR(SB_LEFT_ARROW);             FROB_CURSOR(SB_RIGHT_ARROW);
+       FROB_CURSOR(SB_UP_ARROW);               FROB_CURSOR(SB_V_DOUBLE_ARROW);
+       FROB_CURSOR(SHUTTLE);                   FROB_CURSOR(SIZING);
+       FROB_CURSOR(SPIDER);                    FROB_CURSOR(SPRAYCAN);
+       FROB_CURSOR(STAR);                      FROB_CURSOR(TARGET);
+       FROB_CURSOR(TCROSS);                    FROB_CURSOR(TOP_LEFT_ARROW);
+       FROB_CURSOR(TOP_LEFT_CORNER);           FROB_CURSOR(TOP_RIGHT_CORNER);
+       FROB_CURSOR(TOP_SIDE);                  FROB_CURSOR(TOP_TEE);
+       FROB_CURSOR(TREK);                      FROB_CURSOR(UL_ANGLE);
+       FROB_CURSOR(UMBRELLA);                  FROB_CURSOR(UR_ANGLE);
+       FROB_CURSOR(WATCH);                     FROB_CURSOR(XTERM);
+       FROB_CURSOR(X_CURSOR);
+#undef FROB_CURSOR
+    }
+
+    for (i = 0; i < GDK_NUM_GLYPHS; i++)
+    {
+       if (!the_gdk_cursors[i]) continue;
+       if (!strcmp (the_gdk_cursors[i], name))
+       {
+           return (i);
+       }
+    }
+    return(-1);
+}
+
+static void
+cursor_font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
+                        Lisp_Object pointer_fg, Lisp_Object pointer_bg,
+                        int dest_mask, Lisp_Object domain)
+{
+  /* This function can GC */
+  Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
+  struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+  Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
+  int i;
+  CONST char *name_ext;
+  Lisp_Object foreground, background;
+
+  if (!DEVICE_GTK_P (XDEVICE (device)))
+    signal_simple_error ("Not a Gtk device", device);
+
+  if (!(dest_mask & IMAGE_POINTER_MASK))
+    incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK);
+
+  TO_EXTERNAL_FORMAT (LISP_STRING, data,
+                     C_STRING_ALLOCA, name_ext,
+                     Qfile_name);
+
+  if ((i = cursor_name_to_index (name_ext)) == -1)
+    signal_simple_error ("Unrecognized cursor-font name", data);
+
+  gtk_initialize_pixmap_image_instance (ii, 1, IMAGE_POINTER);
+  IMAGE_INSTANCE_GTK_CURSOR (ii) = gdk_cursor_new (i);
+  foreground = find_keyword_in_vector (instantiator, Q_foreground);
+  if (NILP (foreground))
+    foreground = pointer_fg;
+  background = find_keyword_in_vector (instantiator, Q_background);
+  if (NILP (background))
+    background = pointer_bg;
+  maybe_recolor_cursor (image_instance, foreground, background);
+}
+
+static int
+gtk_colorize_image_instance (Lisp_Object image_instance,
+                            Lisp_Object foreground, Lisp_Object background);
+
+\f
+/************************************************************************/
+/*                      subwindow and widget support                      */
+/************************************************************************/
+
+/* unmap the image if it is a widget. This is used by redisplay via
+   redisplay_unmap_subwindows */
+static void
+gtk_unmap_subwindow (Lisp_Image_Instance *p)
+{
+  if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
+    {
+      /* We don't support subwindows, but we do support widgets... */
+      abort ();
+    }
+  else                         /* must be a widget */
+    {
+      /* Since we are being unmapped we want the enclosing frame to
+        get focus. The losing with simple scrolling but is the safest
+        thing to do. */
+      if (IMAGE_INSTANCE_GTK_CLIPWIDGET (p))
+       gtk_widget_unmap (IMAGE_INSTANCE_GTK_CLIPWIDGET (p));
+    }
+}
+
+/* map the subwindow. This is used by redisplay via
+   redisplay_output_subwindow */
+static void
+gtk_map_subwindow (Lisp_Image_Instance *p, int x, int y,
+                struct display_glyph_area* dga)
+{
+  assert (dga->width > 0 && dga->height > 0);
+
+  if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW)
+    {
+      /* No subwindow support... */
+      abort ();
+    }
+  else                         /* must be a widget */
+    {
+      struct frame *f = XFRAME (IMAGE_INSTANCE_FRAME (p));
+      GtkWidget *wid = IMAGE_INSTANCE_GTK_CLIPWIDGET (p);
+      GtkAllocation a;
+
+      if (!wid) return;
+
+      a.x = x + IMAGE_INSTANCE_GTK_WIDGET_XOFFSET (p);
+      a.y = y + IMAGE_INSTANCE_GTK_WIDGET_YOFFSET (p);
+      a.width = dga->width;
+      a.height = dga->height;
+
+      if ((a.width  != wid->allocation.width)  ||
+         (a.height != wid->allocation.height))
+       {
+         gtk_widget_size_allocate (IMAGE_INSTANCE_GTK_CLIPWIDGET (p), &a);
+       }
+
+      /* #### FIXME DAMMIT */
+      if ((wid->allocation.x != -dga->xoffset) ||
+         (wid->allocation.y != -dga->yoffset))
+       {
+         guint32 old_flags = GTK_WIDGET_FLAGS (FRAME_GTK_TEXT_WIDGET (f));
+
+         /* Fucking GtkFixed widget queues a resize when you add a widget.
+         ** But only if it is visible.
+         ** losers.
+         */
+         GTK_WIDGET_FLAGS(FRAME_GTK_TEXT_WIDGET (f)) &= ~GTK_VISIBLE;
+         if (IMAGE_INSTANCE_GTK_ALREADY_PUT(p))
+           {
+             gtk_fixed_move (GTK_FIXED (FRAME_GTK_TEXT_WIDGET (f)),
+                             wid,
+                             -dga->xoffset, -dga->yoffset);
+           }
+         else
+           {
+             IMAGE_INSTANCE_GTK_ALREADY_PUT(p) = TRUE;
+             gtk_fixed_put (GTK_FIXED (FRAME_GTK_TEXT_WIDGET (f)),
+                            wid,
+                            -dga->xoffset, -dga->yoffset);
+           }
+         GTK_WIDGET_FLAGS(FRAME_GTK_TEXT_WIDGET (f)) = old_flags;
+       }
+
+      if (!IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (p))
+       {
+         gtk_widget_map (wid);
+       }
+
+      gtk_widget_draw (wid, NULL);
+    }
+}
+
+/* when you click on a widget you may activate another widget this
+   needs to be checked and all appropriate widgets updated */
+static void
+gtk_redisplay_subwindow (Lisp_Image_Instance *p)
+{
+  /* Update the subwindow size if necessary. */
+  if (IMAGE_INSTANCE_SIZE_CHANGED (p))
+    {
+#if 0
+      XResizeWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p),
+                    IMAGE_INSTANCE_X_SUBWINDOW_ID (p),
+                    IMAGE_INSTANCE_WIDTH (p),
+                    IMAGE_INSTANCE_HEIGHT (p));
+#endif
+    }
+}
+
+/* Update all attributes that have changed. */
+static void
+gtk_redisplay_widget (Lisp_Image_Instance *p)
+{
+  /* This function can GC if IN_REDISPLAY is false. */
+
+  if (!IMAGE_INSTANCE_GTK_CLIPWIDGET (p))
+    return;
+
+#ifdef HAVE_WIDGETS
+  /* First get the items if they have changed since this is a
+     structural change. As such it will nuke all added values so we
+     need to update most other things after the items have changed.*/
+  gtk_widget_show_all (IMAGE_INSTANCE_GTK_CLIPWIDGET (p));
+  if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (p))
+    {
+      Lisp_Object image_instance;
+
+      XSETIMAGE_INSTANCE (image_instance, p);
+
+      /* Need to update GtkArgs that might have changed... */
+      /* #### FIXME!!! */
+    }
+  else
+    {
+      /* #### FIXME!!! */
+      /* No items changed, so do nothing, right? */
+    }
+
+  /* Possibly update the colors and font */
+  if (IMAGE_INSTANCE_WIDGET_FACE_CHANGED (p)
+      ||
+      /* #### This is not sufficient because it will not cope with widgets
+        that are not currently visible. Once redisplay has done the
+        visible ones it will clear this flag so that when new ones
+        become visible they will not be updated. */
+      XFRAME (IMAGE_INSTANCE_FRAME (p))->faces_changed
+      ||
+      XFRAME (IMAGE_INSTANCE_FRAME (p))->frame_changed
+      ||
+      IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (p))
+    {
+      /* #### Write this function BILL! */
+      update_widget_face (NULL, p, IMAGE_INSTANCE_FRAME (p));
+    }
+
+  /* Possibly update the text. */
+  if (IMAGE_INSTANCE_TEXT_CHANGED (p))
+    {
+      char* str;
+      Lisp_Object val = IMAGE_INSTANCE_WIDGET_TEXT (p);
+      LISP_STRING_TO_EXTERNAL (val, str, Qnative);
+
+      /* #### Need to special case each type of GtkWidget here! */
+    }
+
+  /* Possibly update the size. */
+  if (IMAGE_INSTANCE_SIZE_CHANGED (p)
+      ||
+      IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (p)
+      ||
+      IMAGE_INSTANCE_TEXT_CHANGED (p))
+    {
+      assert (IMAGE_INSTANCE_GTK_WIDGET_ID (p) &&
+             IMAGE_INSTANCE_GTK_CLIPWIDGET (p)) ;
+
+      /* #### Resize the widget! */
+      /* gtk_widget_size_allocate () */
+    }
+
+  /* Adjust offsets within the frame. */
+  if (XFRAME (IMAGE_INSTANCE_FRAME (p))->size_changed)
+    {
+      /* I don't think we need to do anything for Gtk here... */
+    }
+
+  /* now modify the widget */
+#endif
+}
+
+/* instantiate and gtk type subwindow */
+static void
+gtk_subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
+                          Lisp_Object pointer_fg, Lisp_Object pointer_bg,
+                          int dest_mask, Lisp_Object domain)
+{
+  /* This function can GC */
+  Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+  Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
+  Lisp_Object frame = DOMAIN_FRAME (domain);
+
+  if (!DEVICE_GTK_P (XDEVICE (device)))
+    signal_simple_error ("Not a GTK device", device);
+
+  IMAGE_INSTANCE_TYPE (ii) = IMAGE_SUBWINDOW;
+
+  ii->data = xnew_and_zero (struct gtk_subwindow_data);
+
+  /* Create a window for clipping */
+  IMAGE_INSTANCE_GTK_CLIPWINDOW (ii) = NULL;
+
+  /* Now put the subwindow inside the clip window. */
+  IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void *) NULL;
+}
+
+#ifdef HAVE_WIDGETS
+\f
+/************************************************************************/
+/*                            widgets                            */
+/************************************************************************/
+static void
+update_widget_face (GtkWidget *w, Lisp_Image_Instance *ii,
+                   Lisp_Object domain)
+{
+  if (0)
+    {
+      GtkStyle *style = gtk_widget_get_style (w);
+      Lisp_Object pixel = Qnil;
+      GdkColor *fcolor, *bcolor;
+
+      style = gtk_style_copy (style);
+  
+      /* Update the foreground. */
+      pixel = FACE_FOREGROUND (IMAGE_INSTANCE_WIDGET_FACE (ii), domain);
+      fcolor = COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (pixel));
+
+      /* Update the background. */
+      pixel = FACE_BACKGROUND (IMAGE_INSTANCE_WIDGET_FACE (ii), domain);
+      bcolor = COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (pixel));
+
+      /* Update the font */
+      /* #### FIXME!!! Need to copy the widgets style, dick with it, and
+      ** set the widgets style to the new style...
+      */
+      gtk_widget_set_style (w, style);
+
+      /* #### Megahack - but its just getting too complicated to do this
+        in the right place. */
+#if 0
+      if (EQ (IMAGE_INSTANCE_WIDGET_TYPE (ii), Qtab_control))
+       update_tab_widget_face (wv, ii, domain);
+#endif
+    }
+}
+
+#if 0
+static void
+update_tab_widget_face (GtkWidget *w, Lisp_Image_Instance *ii,
+                       Lisp_Object domain)
+{
+  if (wv->contents)
+    {
+      widget_value* val = wv->contents, *cur;
+
+      /* Give each child label the correct foreground color. */
+      Lisp_Object pixel = FACE_FOREGROUND
+       (IMAGE_INSTANCE_WIDGET_FACE (ii),
+        domain);
+      XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel));
+      lw_add_widget_value_arg (val, XtNtabForeground, fcolor.pixel);
+      wv->change = VISIBLE_CHANGE;
+      val->change = VISIBLE_CHANGE;
+
+      for (cur = val->next; cur; cur = cur->next)
+       {
+         cur->change = VISIBLE_CHANGE;
+         if (cur->value)
+           {
+             lw_copy_widget_value_args (val, cur);
+           }
+       }
+    }
+}
+#endif
+
+static Lisp_Object
+gtk_widget_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator,
+                         Lisp_Object pointer_fg, Lisp_Object pointer_bg,
+                         Lisp_Object domain)
+{
+  Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+  Lisp_Object widget = Qnil;
+  char *nm = NULL;
+  GtkWidget *w = NULL;
+  struct gcpro gcpro1;
+
+  IMAGE_INSTANCE_TYPE (ii) = IMAGE_WIDGET;
+
+  if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
+    {
+      LISP_STRING_TO_EXTERNAL (IMAGE_INSTANCE_WIDGET_TEXT (ii), nm, Qnative);
+    }
+
+  ii->data = xnew_and_zero (struct gtk_subwindow_data);
+
+  /* Create a clipping widget */
+  IMAGE_INSTANCE_GTK_CLIPWIDGET (ii) = NULL;
+  IMAGE_INSTANCE_GTK_ALREADY_PUT(ii) = FALSE;
+
+  /* Create the actual widget */
+  GCPRO1 (widget);
+  widget = call5 (Qgtk_widget_instantiate_internal,
+                 image_instance, instantiator,
+                 pointer_fg, pointer_bg,
+                 domain);
+
+  if (!NILP (widget))
+    {
+      CHECK_GTK_OBJECT (widget);
+      w = GTK_WIDGET (XGTK_OBJECT (widget)->object);
+    }
+  else
+    {
+      stderr_out ("Lisp-level creation of widget failed... falling back\n");
+      w = gtk_label_new ("Widget Creation Failed...");
+    }
+
+  UNGCPRO;
+
+  IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void *) w;
+
+  /* #### HACK!!!!  We should make this do the right thing if we
+  ** really need a clip widget!
+  */
+  IMAGE_INSTANCE_GTK_CLIPWIDGET (ii) = w;
+
+  return (Qt);
+}
+
+static void
+gtk_widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
+                       Lisp_Object pointer_fg, Lisp_Object pointer_bg,
+                       int dest_mask, Lisp_Object domain)
+{
+  call_with_suspended_errors ((lisp_fn_t) gtk_widget_instantiate_1,
+                             Qnil, Qimage,
+                             ERROR_ME_WARN, 5,
+                             image_instance, instantiator,
+                             pointer_fg,
+                             pointer_bg,
+                             domain);
+}
+
+/* get properties of a control */
+static Lisp_Object
+gtk_widget_property (Lisp_Object image_instance, Lisp_Object prop)
+{
+  /* Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); */
+
+  /* get the text from a control */
+  if (EQ (prop, Q_text))
+    {
+      return Qnil;
+    }
+  return Qunbound;
+}
+
+#define FAKE_GTK_WIDGET_INSTANTIATOR(x)                                        \
+static void                                                            \
+gtk_##x##_instantiate (Lisp_Object image_instance,                     \
+   Lisp_Object instantiator,                                           \
+   Lisp_Object pointer_fg,                                             \
+   Lisp_Object pointer_bg,                                             \
+   int dest_mask, Lisp_Object domain)                                  \
+{                                                                      \
+  gtk_widget_instantiate (image_instance, instantiator, pointer_fg,    \
+                         pointer_bg, dest_mask, domain);               \
+}
+
+FAKE_GTK_WIDGET_INSTANTIATOR(native_layout);
+FAKE_GTK_WIDGET_INSTANTIATOR(button);
+FAKE_GTK_WIDGET_INSTANTIATOR(progress_gauge);
+FAKE_GTK_WIDGET_INSTANTIATOR(edit_field);
+FAKE_GTK_WIDGET_INSTANTIATOR(combo_box);
+FAKE_GTK_WIDGET_INSTANTIATOR(tab_control);
+FAKE_GTK_WIDGET_INSTANTIATOR(label);
+
+/* Update a button's clicked state. */
+static void
+gtk_button_redisplay (Lisp_Object image_instance)
+{
+  /* This function can GC if IN_REDISPLAY is false. */
+  Lisp_Image_Instance *p = XIMAGE_INSTANCE (image_instance);
+  GtkWidget *w = IMAGE_INSTANCE_GTK_CLIPWIDGET (p);
+
+  if (GTK_WIDGET_TYPE (w) == gtk_button_get_type ())
+    {
+    }
+  else if (GTK_WIDGET_TYPE (w) == gtk_check_button_get_type ())
+    {
+    }
+  else if (GTK_WIDGET_TYPE (w) == gtk_radio_button_get_type ())
+    {
+    }
+  else
+    {
+      /* Unknown button type... */
+      abort();
+    }
+}
+
+/* get properties of a button */
+static Lisp_Object
+gtk_button_property (Lisp_Object image_instance, Lisp_Object prop)
+{
+  Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+
+  /* check the state of a button */
+  if (EQ (prop, Q_selected))
+    {
+      if (GTK_WIDGET_HAS_FOCUS (IMAGE_INSTANCE_SUBWINDOW_ID (ii)))
+       return Qt;
+      else
+       return Qnil;
+    }
+  return Qunbound;
+}
+
+/* set the properties of a progress gauge */
+static void
+gtk_progress_gauge_redisplay (Lisp_Object image_instance)
+{
+  Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+
+  if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii))
+    {
+      gfloat f;
+      Lisp_Object val;
+
+      val = XGUI_ITEM (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))->value;
+      f = XFLOATINT (val);
+
+      gtk_progress_set_value (GTK_PROGRESS (IMAGE_INSTANCE_SUBWINDOW_ID (ii)),
+                             f);
+    }
+}
+
+/* Set the properties of a tab control */
+static void
+gtk_tab_control_redisplay (Lisp_Object image_instance)
+{
+  /* #### Convert this to GTK baby! */
+  Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
+
+  if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) ||
+      IMAGE_INSTANCE_WIDGET_ACTION_OCCURRED (ii))
+    {
+      /* If only the order has changed then simply select the first
+        one of the pending set. This stops horrendous rebuilding -
+        and hence flicker - of the tabs each time you click on
+        one. */
+      if (tab_control_order_only_changed (image_instance))
+       {
+         Lisp_Object rest, selected =
+           gui_item_list_find_selected
+           (NILP (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii)) ?
+            XCDR (IMAGE_INSTANCE_WIDGET_ITEMS (ii)) :
+            XCDR (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii)));
+
+         LIST_LOOP (rest, XCDR (IMAGE_INSTANCE_WIDGET_ITEMS (ii)))
+           {
+             if (gui_item_equal_sans_selected (XCAR (rest), selected, 0))
+               {
+                 Lisp_Object old_selected =gui_item_list_find_selected
+                   (XCDR (IMAGE_INSTANCE_WIDGET_ITEMS (ii)));
+
+                 /* Need to focus on the widget... */
+                 stderr_out ("Hey, change the tab-focus you boob...\n");
+
+                 /* Pick up the new selected item. */
+                 XGUI_ITEM (old_selected)->selected =
+                   XGUI_ITEM (XCAR (rest))->selected;
+                 XGUI_ITEM (XCAR (rest))->selected =
+                   XGUI_ITEM (selected)->selected;
+                 /* We're not actually changing the items anymore. */
+                 IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) = 0;
+                 IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii) = Qnil;
+                 break;
+               }
+           }
+       }
+      else
+       {
+         /* More than just the order has changed... let's get busy! */
+         GtkNotebook *nb = GTK_NOTEBOOK (IMAGE_INSTANCE_GTK_CLIPWIDGET (ii));
+         guint num_pages = g_list_length (nb->children);
+         Lisp_Object rest;
+
+         if (num_pages >= 0)
+           {
+             int i;
+             for (i = num_pages; i >= 0; --i)
+               {
+                 gtk_notebook_remove_page (nb, i);
+               }
+           }
+
+         LIST_LOOP (rest, XCDR (IMAGE_INSTANCE_WIDGET_ITEMS (ii)))
+           {
+             Lisp_Gui_Item *pgui = XGUI_ITEM (XCAR (rest));
+             char *c_name = NULL;
+
+             if (!STRINGP (pgui->name))
+               pgui->name = Feval (pgui->name);
+
+             CHECK_STRING (pgui->name);
+
+             TO_EXTERNAL_FORMAT (LISP_STRING, pgui->name,
+                                 C_STRING_ALLOCA, c_name,
+                                 Qctext);
+
+             gtk_notebook_append_page (nb,
+                                       gtk_vbox_new (FALSE, 3),
+                                       gtk_label_new (c_name));
+           }
+
+         /* Show all the new widgets we just added... */
+         gtk_widget_show_all (GTK_WIDGET (nb));
+       }
+    }
+
+  /* Possibly update the face. */
+#if 0
+  if (IMAGE_INSTANCE_WIDGET_FACE_CHANGED (ii)
+      ||
+      XFRAME (IMAGE_INSTANCE_FRAME (ii))->faces_changed
+      ||
+      IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii))
+    {
+      update_tab_widget_face (wv, ii,
+                             IMAGE_INSTANCE_FRAME (ii));
+    }
+#endif
+}
+#endif /* HAVE_WIDGETS */
+
+\f
+/************************************************************************/
+/*                            initialization                            */
+/************************************************************************/
+void
+syms_of_glyphs_gtk (void)
+{
+  defkeyword (&Q_resource_id, ":resource-id");
+  defkeyword (&Q_resource_type, ":resource-type");
+#ifdef HAVE_WIDGETS
+  defsymbol (&Qgtk_widget_instantiate_internal, "gtk-widget-instantiate-internal");
+  defsymbol (&Qgtk_widget_property_internal, "gtk-widget-property-internal");
+  defsymbol (&Qgtk_widget_redisplay_internal, "gtk-widget-redisplay-internal");
+  defsymbol (&Qgtk_widget_set_style, "gtk-widget-set-style");
+#endif
+}
+
+void
+console_type_create_glyphs_gtk (void)
+{
+  /* image methods */
+  CONSOLE_HAS_METHOD (gtk, print_image_instance);
+  CONSOLE_HAS_METHOD (gtk, finalize_image_instance);
+  CONSOLE_HAS_METHOD (gtk, image_instance_equal);
+  CONSOLE_HAS_METHOD (gtk, image_instance_hash);
+  CONSOLE_HAS_METHOD (gtk, colorize_image_instance);
+  CONSOLE_HAS_METHOD (gtk, init_image_instance_from_eimage);
+  CONSOLE_HAS_METHOD (gtk, locate_pixmap_file);
+  CONSOLE_HAS_METHOD (gtk, unmap_subwindow);
+  CONSOLE_HAS_METHOD (gtk, map_subwindow);
+  CONSOLE_HAS_METHOD (gtk, redisplay_widget);
+  CONSOLE_HAS_METHOD (gtk, redisplay_subwindow);
+}
+
+void
+image_instantiator_format_create_glyphs_gtk (void)
+{
+  IIFORMAT_VALID_CONSOLE (gtk, nothing);
+  IIFORMAT_VALID_CONSOLE (gtk, string);
+#ifdef HAVE_WIDGETS
+  IIFORMAT_VALID_CONSOLE (gtk, layout);
+#endif
+  IIFORMAT_VALID_CONSOLE (gtk, formatted_string);
+  IIFORMAT_VALID_CONSOLE (gtk, inherit);
+#ifdef HAVE_XPM
+  INITIALIZE_DEVICE_IIFORMAT (gtk, xpm);
+  IIFORMAT_HAS_DEVMETHOD (gtk, xpm, instantiate);
+#endif
+#ifdef HAVE_JPEG
+  IIFORMAT_VALID_CONSOLE (gtk, jpeg);
+#endif
+#ifdef HAVE_TIFF
+  IIFORMAT_VALID_CONSOLE (gtk, tiff);
+#endif
+#ifdef HAVE_PNG
+  IIFORMAT_VALID_CONSOLE (gtk, png);
+#endif
+#ifdef HAVE_GIF
+  IIFORMAT_VALID_CONSOLE (gtk, gif);
+#endif
+
+  INITIALIZE_DEVICE_IIFORMAT (gtk, subwindow);
+  IIFORMAT_HAS_DEVMETHOD (gtk, subwindow, instantiate);
+
+#ifdef HAVE_WIDGETS
+  /* layout widget */
+  INITIALIZE_DEVICE_IIFORMAT (gtk, native_layout);
+  IIFORMAT_HAS_DEVMETHOD (gtk, native_layout, instantiate);
+
+  /* button widget */
+  INITIALIZE_DEVICE_IIFORMAT (gtk, button);
+  IIFORMAT_HAS_DEVMETHOD (gtk, button, property);
+  IIFORMAT_HAS_DEVMETHOD (gtk, button, instantiate);
+  IIFORMAT_HAS_DEVMETHOD (gtk, button, redisplay);
+  /* general widget methods. */
+  INITIALIZE_DEVICE_IIFORMAT (gtk, widget);
+  IIFORMAT_HAS_DEVMETHOD (gtk, widget, property);
+
+  /* progress gauge */
+  INITIALIZE_DEVICE_IIFORMAT (gtk, progress_gauge);
+  IIFORMAT_HAS_DEVMETHOD (gtk, progress_gauge, redisplay);
+  IIFORMAT_HAS_DEVMETHOD (gtk, progress_gauge, instantiate);
+  /* text field */
+  INITIALIZE_DEVICE_IIFORMAT (gtk, edit_field);
+  IIFORMAT_HAS_DEVMETHOD (gtk, edit_field, instantiate);
+  INITIALIZE_DEVICE_IIFORMAT (gtk, combo_box);
+  IIFORMAT_HAS_DEVMETHOD (gtk, combo_box, instantiate);
+  IIFORMAT_HAS_SHARED_DEVMETHOD (gtk, combo_box, redisplay, tab_control);
+  /* tab control widget */
+  INITIALIZE_DEVICE_IIFORMAT (gtk, tab_control);
+  IIFORMAT_HAS_DEVMETHOD (gtk, tab_control, instantiate);
+  IIFORMAT_HAS_DEVMETHOD (gtk, tab_control, redisplay);
+  /* label */
+  INITIALIZE_DEVICE_IIFORMAT (gtk, label);
+  IIFORMAT_HAS_DEVMETHOD (gtk, label, instantiate);
+#endif
+
+  INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (cursor_font, "cursor-font");
+  IIFORMAT_VALID_CONSOLE (gtk, cursor_font);
+
+  IIFORMAT_HAS_METHOD (cursor_font, validate);
+  IIFORMAT_HAS_METHOD (cursor_font, possible_dest_types);
+  IIFORMAT_HAS_METHOD (cursor_font, instantiate);
+
+  IIFORMAT_VALID_KEYWORD (cursor_font, Q_data, check_valid_string);
+  IIFORMAT_VALID_KEYWORD (cursor_font, Q_foreground, check_valid_string);
+  IIFORMAT_VALID_KEYWORD (cursor_font, Q_background, check_valid_string);
+
+  INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (font, "font");
+  IIFORMAT_VALID_CONSOLE (gtk, font);
+
+  IIFORMAT_HAS_METHOD (font, validate);
+  IIFORMAT_HAS_METHOD (font, possible_dest_types);
+  IIFORMAT_HAS_METHOD (font, instantiate);
+
+  IIFORMAT_VALID_KEYWORD (font, Q_data, check_valid_string);
+  IIFORMAT_VALID_KEYWORD (font, Q_foreground, check_valid_string);
+  IIFORMAT_VALID_KEYWORD (font, Q_background, check_valid_string);
+
+#ifdef HAVE_XPM
+  INITIALIZE_DEVICE_IIFORMAT (gtk, xpm);
+  IIFORMAT_HAS_DEVMETHOD (gtk, xpm, instantiate);
+#endif
+
+#ifdef HAVE_XFACE
+  INITIALIZE_DEVICE_IIFORMAT (gtk, xface);
+  IIFORMAT_HAS_DEVMETHOD (gtk, xface, instantiate);
+#endif
+
+  INITIALIZE_DEVICE_IIFORMAT (gtk, xbm);
+  IIFORMAT_HAS_DEVMETHOD (gtk, xbm, instantiate);
+  IIFORMAT_VALID_CONSOLE (gtk, xbm);
+
+  INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (gtk_resource, "gtk-resource");
+  IIFORMAT_VALID_CONSOLE (gtk, gtk_resource);
+
+  IIFORMAT_HAS_METHOD (gtk_resource, validate);
+  IIFORMAT_HAS_METHOD (gtk_resource, normalize);
+  IIFORMAT_HAS_METHOD (gtk_resource, possible_dest_types);
+  IIFORMAT_HAS_METHOD (gtk_resource, instantiate);
+
+  IIFORMAT_VALID_KEYWORD (gtk_resource, Q_resource_type, check_valid_resource_symbol);
+  IIFORMAT_VALID_KEYWORD (gtk_resource, Q_resource_id, check_valid_resource_id);
+  IIFORMAT_VALID_KEYWORD (gtk_resource, Q_file, check_valid_string);
+
+  INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (autodetect, "autodetect");
+  IIFORMAT_VALID_CONSOLE (gtk, autodetect);
+
+  IIFORMAT_HAS_METHOD (autodetect, validate);
+  IIFORMAT_HAS_METHOD (autodetect, normalize);
+  IIFORMAT_HAS_METHOD (autodetect, possible_dest_types);
+  IIFORMAT_HAS_METHOD (autodetect, instantiate);
+
+  IIFORMAT_VALID_KEYWORD (autodetect, Q_data, check_valid_string);
+}
+
+void
+vars_of_glyphs_gtk (void)
+{
+#ifdef HAVE_XFACE
+  Fprovide (Qxface);
+#endif
+
+  DEFVAR_LISP ("gtk-bitmap-file-path", &Vgtk_bitmap_file_path /*
+A list of the directories in which X bitmap files may be found.
+If nil, this is initialized from the "*bitmapFilePath" resource.
+This is used by the `make-image-instance' function (however, note that if
+the environment variable XBMLANGPATH is set, it is consulted first).
+*/ );
+  Vgtk_bitmap_file_path = Qnil;
+}
+
+void
+complex_vars_of_glyphs_gtk (void)
+{
+#define BUILD_GLYPH_INST(variable, name)                       \
+  Fadd_spec_to_specifier                                       \
+    (GLYPH_IMAGE (XGLYPH (variable)),                          \
+     vector3 (Qxbm, Q_data,                                    \
+             list3 (make_int (name##_width),                   \
+                    make_int (name##_height),                  \
+                    make_ext_string (name##_bits,              \
+                                     sizeof (name##_bits),     \
+                                     Qbinary))),               \
+     Qglobal, Qgtk, Qnil)
+
+  BUILD_GLYPH_INST (Vtruncation_glyph, truncator);
+  BUILD_GLYPH_INST (Vcontinuation_glyph, continuer);
+  BUILD_GLYPH_INST (Vxemacs_logo, xemacs);
+  BUILD_GLYPH_INST (Vhscroll_glyph, hscroll);
+
+#undef BUILD_GLYPH_INST
+}
+
+\f
+/* Ripped off from glyphs-msw.c */
+/*
+ * The data returned by the following routine is always in left-most byte
+ * first and left-most bit first.  If it doesn't return BitmapSuccess then
+ * its arguments won't have been touched.  This routine should look as much
+ * like the Xlib routine XReadBitmapfile as possible.
+ */
+#define MAX_SIZE 1024
+
+/* shared data for the image read/parse logic */
+static short hexTable[256];            /* conversion value */
+static int initialized = FALSE;        /* easier to fill in at run time */
+
+/*
+ *     Table index for the hex values. Initialized once, first time.
+ *     Used for translation value or delimiter significance lookup.
+ */
+static void initHexTable()
+{
+    /*
+     * We build the table at run time for several reasons:
+     *
+     *     1.  portable to non-ASCII machines.
+     *     2.  still reentrant since we set the init flag after setting table.
+     *     3.  easier to extend.
+     *     4.  less prone to bugs.
+     */
+    hexTable['0'] = 0; hexTable['1'] = 1;
+    hexTable['2'] = 2; hexTable['3'] = 3;
+    hexTable['4'] = 4; hexTable['5'] = 5;
+    hexTable['6'] = 6; hexTable['7'] = 7;
+    hexTable['8'] = 8; hexTable['9'] = 9;
+    hexTable['A'] = 10;        hexTable['B'] = 11;
+    hexTable['C'] = 12;        hexTable['D'] = 13;
+    hexTable['E'] = 14;        hexTable['F'] = 15;
+    hexTable['a'] = 10;        hexTable['b'] = 11;
+    hexTable['c'] = 12;        hexTable['d'] = 13;
+    hexTable['e'] = 14;        hexTable['f'] = 15;
+
+    /* delimiters of significance are flagged w/ negative value */
+    hexTable[' '] = -1;        hexTable[','] = -1;
+    hexTable['}'] = -1;        hexTable['\n'] = -1;
+    hexTable['\t'] = -1;
+       
+    initialized = TRUE;
+}
+
+/*
+ *     read next hex value in the input stream, return -1 if EOF
+ */
+static int NextInt ( FILE *fstream )
+{
+    int        ch;
+    int        value = 0;
+    int gotone = 0;
+    int done = 0;
+    
+    /* loop, accumulate hex value until find delimiter  */
+    /* skip any initial delimiters found in read stream */
+
+    while (!done) {
+       ch = getc(fstream);
+       if (ch == EOF) {
+           value       = -1;
+           done++;
+       } else {
+           /* trim high bits, check type and accumulate */
+           ch &= 0xff;
+           if (isascii(ch) && isxdigit(ch)) {
+               value = (value << 4) + hexTable[ch];
+               gotone++;
+           } else if ((hexTable[ch]) < 0 && gotone)
+             done++;
+       }
+    }
+    return value;
+}
+
+int read_bitmap_data (fstream, width, height, datap, x_hot, y_hot)
+    FILE *fstream;                     /* handle on file  */
+    unsigned int *width, *height;      /* RETURNED */
+    unsigned char **datap;             /* RETURNED */
+    int *x_hot, *y_hot;                        /* RETURNED */
+{
+    unsigned char *data = NULL;                /* working variable */
+    char line[MAX_SIZE];               /* input line from file */
+    int size;                          /* number of bytes of data */
+    char name_and_type[MAX_SIZE];      /* an input line */
+    char *type;                                /* for parsing */
+    int value;                         /* from an input line */
+    int version10p;                    /* boolean, old format */
+    int padding;                       /* to handle alignment */
+    int bytes_per_line;                        /* per scanline of data */
+    unsigned int ww = 0;               /* width */
+    unsigned int hh = 0;               /* height */
+    int hx = -1;                       /* x hotspot */
+    int hy = -1;                       /* y hotspot */
+
+#define Xmalloc(size) malloc(size)
+
+    /* first time initialization */
+    if (initialized == FALSE) initHexTable();
+
+    /* error cleanup and return macro  */
+#define        RETURN(code) { if (data) free (data); return code; }
+
+    while (fgets(line, MAX_SIZE, fstream)) {
+       if (strlen(line) == MAX_SIZE-1) {
+           RETURN (BitmapFileInvalid);
+       }
+       if (sscanf(line,"#define %s %d",name_and_type,&value) == 2) {
+           if (!(type = strrchr(name_and_type, '_')))
+               type = name_and_type;
+           else
+               type++;
+
+           if (!strcmp("width", type))
+               ww = (unsigned int) value;
+           if (!strcmp("height", type))
+               hh = (unsigned int) value;
+           if (!strcmp("hot", type)) {
+               if (type-- == name_and_type || type-- == name_and_type)
+                   continue;
+               if (!strcmp("x_hot", type))
+                   hx = value;
+               if (!strcmp("y_hot", type))
+                   hy = value;
+           }
+           continue;
+       }
+    
+       if (sscanf(line, "static short %s = {", name_and_type) == 1)
+           version10p = 1;
+       else if (sscanf(line,"static unsigned char %s = {",name_and_type) == 1)
+           version10p = 0;
+       else if (sscanf(line, "static char %s = {", name_and_type) == 1)
+           version10p = 0;
+       else
+           continue;
+
+       if (!(type = strrchr(name_and_type, '_')))
+           type = name_and_type;
+       else
+           type++;
+
+       if (strcmp("bits[]", type))
+           continue;
+    
+       if (!ww || !hh)
+           RETURN (BitmapFileInvalid);
+
+       if ((ww % 16) && ((ww % 16) < 9) && version10p)
+           padding = 1;
+       else
+           padding = 0;
+
+       bytes_per_line = (ww+7)/8 + padding;
+
+       size = bytes_per_line * hh;
+       data = (unsigned char *) Xmalloc ((unsigned int) size);
+       if (!data) 
+           RETURN (BitmapNoMemory);
+
+       if (version10p) {
+           unsigned char *ptr;
+           int bytes;
+
+           for (bytes=0, ptr=data; bytes<size; (bytes += 2)) {
+               if ((value = NextInt(fstream)) < 0)
+                   RETURN (BitmapFileInvalid);
+               *(ptr++) = value;
+               if (!padding || ((bytes+2) % bytes_per_line))
+                   *(ptr++) = value >> 8;
+           }
+       } else {
+           unsigned char *ptr;
+           int bytes;
+
+           for (bytes=0, ptr=data; bytes<size; bytes++, ptr++) {
+               if ((value = NextInt(fstream)) < 0) 
+                   RETURN (BitmapFileInvalid);
+               *ptr=value;
+           }
+       }
+       break;
+    }                                  /* end while */
+
+    if (data == NULL) {
+       RETURN (BitmapFileInvalid);
+    }
+
+    *datap = data;
+    data = NULL;
+    *width = ww;
+    *height = hh;
+    if (x_hot) *x_hot = hx;
+    if (y_hot) *y_hot = hy;
+
+    RETURN (BitmapSuccess);
+}
+
+
+int read_bitmap_data_from_file (CONST char *filename, unsigned int *width, 
+                               unsigned int *height, unsigned char **datap,
+                               int *x_hot, int *y_hot)
+{
+    FILE *fstream;
+    int rval;
+
+    if ((fstream = fopen (filename, "r")) == NULL) {
+       return BitmapOpenFailed;
+    }
+    rval = read_bitmap_data (fstream, width, height, datap, x_hot, y_hot);
+    fclose (fstream);
+    return rval;
+}
+
+/* X specific crap */
+#include <gdk/gdkx.h>
+/* #### Should remove all this X specific stuff when GTK/GDK matures a
+   bit more and provides an abstraction for it. */
+static int
+gtk_colorize_image_instance (Lisp_Object image_instance,
+                            Lisp_Object foreground, Lisp_Object background)
+{
+  struct Lisp_Image_Instance *p;
+
+  p = XIMAGE_INSTANCE (image_instance);
+
+  switch (IMAGE_INSTANCE_TYPE (p))
+    {
+    case IMAGE_MONO_PIXMAP:
+      IMAGE_INSTANCE_TYPE (p) = IMAGE_COLOR_PIXMAP;
+      /* Make sure there aren't two pointers to the same mask, causing
+        it to get freed twice. */
+      IMAGE_INSTANCE_GTK_MASK (p) = 0;
+      break;
+
+    default:
+      return 0;
+    }
+
+  {
+    GdkWindow *draw = GET_GTK_WIDGET_WINDOW (DEVICE_GTK_APP_SHELL (XDEVICE (IMAGE_INSTANCE_DEVICE (p))));
+    GdkPixmap *new_pxmp = gdk_pixmap_new (draw,
+                                         IMAGE_INSTANCE_PIXMAP_WIDTH (p),
+                                         IMAGE_INSTANCE_PIXMAP_HEIGHT (p),
+                                         DEVICE_GTK_DEPTH (XDEVICE (IMAGE_INSTANCE_DEVICE (p))));
+    GdkGCValues gcv;
+    GdkGC *gc;
+
+    gcv.foreground = * COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (foreground));
+    gcv.background = * COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (background));
+    gc = gdk_gc_new_with_values (new_pxmp, &gcv, GDK_GC_BACKGROUND | GDK_GC_FOREGROUND);
+
+    XCopyPlane (GDK_WINDOW_XDISPLAY (draw),
+               GDK_WINDOW_XWINDOW (IMAGE_INSTANCE_GTK_PIXMAP (p)),
+               GDK_WINDOW_XWINDOW (new_pxmp),
+               GDK_GC_XGC (gc), 0, 0,
+               IMAGE_INSTANCE_PIXMAP_WIDTH (p),
+               IMAGE_INSTANCE_PIXMAP_HEIGHT (p),
+               0, 0, 1);
+
+    gdk_gc_destroy (gc);
+    IMAGE_INSTANCE_GTK_PIXMAP (p) = new_pxmp;
+    IMAGE_INSTANCE_PIXMAP_DEPTH (p) = DEVICE_GTK_DEPTH (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
+    IMAGE_INSTANCE_PIXMAP_FG (p) = foreground;
+    IMAGE_INSTANCE_PIXMAP_BG (p) = background;
+    return 1;
+  }
+}
+

diff --git a/src/glyphs-gtk.h b/src/glyphs-gtk.h
new file mode 100644 (file)
index 0000000..0a99770
--- /dev/null
+++ b/src/glyphs-gtk.h
@@ -0,0 +1,157 @@
+/* Gtk-specific glyphs and related.
+   Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+   Copyright (C) 1995 Board of Trustees, University of Illinois.
+   Copyright (C) 1995, 1996 Ben Wing
+   Copyright (C) 1995 Sun Microsystems, Inc.
+
+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, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with:  Not in FSF. */
+/* Gtk version by William Perry */
+
+#ifndef _XEMACS_GLYPHS_GTK_H_
+#define _XEMACS_GLYPHS_GTK_H_
+
+#include "glyphs.h"
+
+#ifdef HAVE_GTK
+
+#include <gtk/gtk.h>
+
+/****************************************************************************
+ *                         Image-Instance Object                            *
+ ****************************************************************************/
+
+struct gtk_image_instance_data
+{
+  GdkPixmap **pixmaps;
+  GdkPixmap *mask;
+  GdkCursor *cursor;
+
+  /* If depth>0, then that means that other colors were allocated when
+     this pixmap was loaded.  These are they; we need to free them when
+     finalizing the image instance. */
+  GdkColormap *colormap;
+  unsigned long *pixels;
+  int npixels;
+
+  /* Should we hang on to the extra info from the XpmAttributes, like
+     the textual color table and the comments?   Is that useful? */
+};
+
+struct gtk_subwindow_data
+{
+  union
+  {
+    struct
+    {
+      GtkWidget *parent_window;
+      GtkWidget *clip_window;
+    } sub;
+    struct
+    {
+      GtkWidget *clip_window;
+      Lisp_Object widget;
+      guint x_offset;
+      guint y_offset;
+      gboolean added_to_fixed;
+    } wid;
+  } data;
+};
+
+void init_image_instance_from_gdk_pixmap (struct Lisp_Image_Instance *ii,
+                                         struct device *device,
+                                         GdkPixmap *gdk_pixmap,
+                                         int dest_mask,
+                                         Lisp_Object instantiator);
+
+#define GTK_IMAGE_INSTANCE_DATA(i) ((struct gtk_image_instance_data *) (i)->data)
+
+#define IMAGE_INSTANCE_GTK_PIXMAP(i) (GTK_IMAGE_INSTANCE_DATA (i)->pixmaps[0])
+#define IMAGE_INSTANCE_GTK_PIXMAP_SLICE(i,slice) \
+     (GTK_IMAGE_INSTANCE_DATA (i)->pixmaps[slice])
+#define IMAGE_INSTANCE_GTK_PIXMAP_SLICES(i) \
+     (GTK_IMAGE_INSTANCE_DATA (i)->pixmaps)
+#define IMAGE_INSTANCE_GTK_MASK(i) (GTK_IMAGE_INSTANCE_DATA (i)->mask)
+#define IMAGE_INSTANCE_GTK_CURSOR(i) (GTK_IMAGE_INSTANCE_DATA (i)->cursor)
+#define IMAGE_INSTANCE_GTK_COLORMAP(i) (GTK_IMAGE_INSTANCE_DATA (i)->colormap)
+#define IMAGE_INSTANCE_GTK_PIXELS(i) (GTK_IMAGE_INSTANCE_DATA (i)->pixels)
+#define IMAGE_INSTANCE_GTK_NPIXELS(i) (GTK_IMAGE_INSTANCE_DATA (i)->npixels)
+
+#define XIMAGE_INSTANCE_GTK_PIXMAP(i) \
+  IMAGE_INSTANCE_GTK_PIXMAP (XIMAGE_INSTANCE (i))
+#define XIMAGE_INSTANCE_GTK_PIXMAP_SLICE(i) \
+  IMAGE_INSTANCE_GTK_PIXMAP_SLICE (XIMAGE_INSTANCE (i))
+#define XIMAGE_INSTANCE_GTK_PIXMAP_SLICES(i) \
+  IMAGE_INSTANCE_GTK_PIXMAP_SLICES (XIMAGE_INSTANCE (i))
+#define XIMAGE_INSTANCE_GTK_MASK(i) \
+  IMAGE_INSTANCE_GTK_MASK (XIMAGE_INSTANCE (i))
+#define XIMAGE_INSTANCE_GTK_CURSOR(i) \
+  IMAGE_INSTANCE_GTK_CURSOR (XIMAGE_INSTANCE (i))
+#define XIMAGE_INSTANCE_GTK_PIXELS(i) \
+  IMAGE_INSTANCE_GTK_PIXELS (XIMAGE_INSTANCE (i))
+#define XIMAGE_INSTANCE_GTK_NPIXELS(i) \
+  IMAGE_INSTANCE_GTK_NPIXELS (XIMAGE_INSTANCE (i))
+
+/* Subwindow / widget stuff */
+#define GTK_SUBWINDOW_INSTANCE_DATA(i) ((struct gtk_subwindow_data *) (i)->data)
+
+#define IMAGE_INSTANCE_GTK_SUBWINDOW_PARENT(i) \
+  (GTK_SUBWINDOW_INSTANCE_DATA (i)->data.sub.parent_window)
+#define IMAGE_INSTANCE_GTK_CLIPWINDOW(i) \
+  (GTK_SUBWINDOW_INSTANCE_DATA (i)->data.sub.clip_window)
+#define IMAGE_INSTANCE_GTK_WIDGET_XOFFSET(i) \
+  (GTK_SUBWINDOW_INSTANCE_DATA (i)->data.wid.x_offset)
+#define IMAGE_INSTANCE_GTK_WIDGET_YOFFSET(i) \
+  (GTK_SUBWINDOW_INSTANCE_DATA (i)->data.wid.y_offset)
+#define IMAGE_INSTANCE_GTK_WIDGET_LWID(i) \
+  (GTK_SUBWINDOW_INSTANCE_DATA (i)->data.wid.id)
+#define IMAGE_INSTANCE_GTK_CLIPWIDGET(i) \
+  (GTK_SUBWINDOW_INSTANCE_DATA (i)->data.wid.clip_window)
+#define IMAGE_INSTANCE_GTK_ALREADY_PUT(i) \
+  (GTK_SUBWINDOW_INSTANCE_DATA (i)->data.wid.added_to_fixed)
+#define IMAGE_INSTANCE_GTK_SUBWINDOW_ID(i) \
+  ((GdkWindow *) & IMAGE_INSTANCE_SUBWINDOW_ID (i))
+#define IMAGE_INSTANCE_GTK_WIDGET_ID(i) \
+  ((GtkWidget *) & IMAGE_INSTANCE_SUBWINDOW_ID (i))
+
+#define XIMAGE_INSTANCE_GTK_SUBWINDOW_PARENT(i) \
+  IMAGE_INSTANCE_GTK_SUBWINDOW_PARENT (XIMAGE_INSTANCE (i))
+#define XIMAGE_INSTANCE_GTK_SUBWINDOW_DISPLAY(i) \
+  IMAGE_INSTANCE_GTK_SUBWINDOW_DISPLAY (XIMAGE_INSTANCE (i))
+#define XIMAGE_INSTANCE_GTK_WIDGET_XOFFSET(i) \
+  IMAGE_INSTANCE_GTK_WIDGET_XOFFSET (XIMAGE_INSTANCE (i))
+#define XIMAGE_INSTANCE_GTK_WIDGET_YOFFSET(i) \
+  IMAGE_INSTANCE_GTK_WIDGET_YOFFSET (XIMAGE_INSTANCE (i))
+#define XIMAGE_INSTANCE_GTK_WIDGET_LWID(i) \
+  IMAGE_INSTANCE_GTK_WIDGET_LWID (XIMAGE_INSTANCE (i))
+#define XIMAGE_INSTANCE_GTK_CLIPWIDGET(i) \
+  IMAGE_INSTANCE_GTK_CLIPWIDGET (XIMAGE_INSTANCE (i))
+#define XIMAGE_INSTANCE_GTK_CLIPWINDOW(i) \
+  IMAGE_INSTANCE_GTK_CLIPWINDOW (XIMAGE_INSTANCE (i))
+#define XIMAGE_INSTANCE_GTK_WIDGET_ID(i) \
+  IMAGE_INSTANCE_GTK_WIDGET_ID (XIMAGE_INSTANCE (i))
+
+#define DOMAIN_GTK_WIDGET(domain) \
+  ((IMAGE_INSTANCEP (domain) && \
+  GTK_SUBWINDOW_INSTANCE_DATA (XIMAGE_INSTANCE (domain))) ? \
+   XIMAGE_INSTANCE_GTK_WIDGET_ID (domain) : \
+   FRAME_GTK_CONTAINER_WIDGET (f) (DOMAIN_XFRAME (domain)))
+
+#endif /* HAVE_GTK */
+#endif /* _XEMACS_GLYPHS_GTK_H_ */

diff --git a/src/gtk-glue.c b/src/gtk-glue.c
new file mode 100644 (file)
index 0000000..66cc549
--- /dev/null
+++ b/src/gtk-glue.c
@@ -0,0 +1,265 @@
+GtkType GTK_TYPE_ARRAY = 0;
+GtkType GTK_TYPE_STRING_ARRAY = 0;
+GtkType GTK_TYPE_FLOAT_ARRAY = 0;
+GtkType GTK_TYPE_INT_ARRAY = 0;
+GtkType GTK_TYPE_LISTOF = 0;
+GtkType GTK_TYPE_STRING_LIST = 0;
+GtkType GTK_TYPE_OBJECT_LIST = 0;
+GtkType GTK_TYPE_GDK_GC = 0;
+
+static GtkType
+xemacs_type_register (gchar *name, GtkType parent)
+{
+  GtkType type_id;
+  GtkTypeInfo info;
+
+  info.type_name = name;
+  info.object_size = 0;
+  info.class_size = 0;
+  info.class_init_func = NULL;
+  info.object_init_func = NULL;
+  info.reserved_1 = NULL;
+  info.reserved_2 = NULL;
+
+  type_id = gtk_type_unique (parent, &info);
+
+  return (type_id);
+}
+
+static void
+xemacs_init_gtk_classes (void)
+{
+  if (!GTK_TYPE_ARRAY)
+    {
+      GTK_TYPE_ARRAY = xemacs_type_register ("GtkArrayOf", 0);
+      GTK_TYPE_STRING_ARRAY = xemacs_type_register ("GtkArrayOfString", GTK_TYPE_ARRAY);
+      GTK_TYPE_FLOAT_ARRAY = xemacs_type_register ("GtkArrayOfFloat", GTK_TYPE_ARRAY);
+      GTK_TYPE_INT_ARRAY = xemacs_type_register ("GtkArrayOfInteger", GTK_TYPE_ARRAY);
+      GTK_TYPE_LISTOF = xemacs_type_register ("GtkListOf", 0);
+      GTK_TYPE_STRING_LIST = xemacs_type_register ("GtkListOfString", GTK_TYPE_LISTOF);
+      GTK_TYPE_OBJECT_LIST = xemacs_type_register ("GtkListOfObject", GTK_TYPE_LISTOF);
+      GTK_TYPE_GDK_GC = xemacs_type_register ("GdkGC", GTK_TYPE_BOXED);
+  }
+}
+
+static void
+xemacs_list_to_gtklist (Lisp_Object obj, GtkArg *arg)
+{
+  CHECK_LIST (obj);
+
+  if (arg->type == GTK_TYPE_STRING_LIST)
+    {
+      Lisp_Object temp = obj;
+      GList *strings = NULL;
+
+      while (!NILP (temp))
+       {
+         CHECK_STRING (XCAR (temp));
+         temp = XCDR (temp);
+       }
+
+      temp = obj;
+
+      while (!NILP (temp))
+       {
+         strings = g_list_append (strings, XSTRING_DATA (XCAR (temp)));
+         temp = XCDR (temp);
+       }
+
+      GTK_VALUE_POINTER(*arg) = strings;
+    }
+  else if (arg->type == GTK_TYPE_OBJECT_LIST)
+    {
+      Lisp_Object temp = obj;
+      GList *objects = NULL;
+
+      while (!NILP (temp))
+       {
+         CHECK_GTK_OBJECT (XCAR (temp));
+         temp = XCDR (temp);
+       }
+
+      temp = obj;
+
+      while (!NILP (temp))
+       {
+         objects = g_list_append (objects, XGTK_OBJECT (XCAR (temp))->object);
+         temp = XCDR (temp);
+       }
+
+      GTK_VALUE_POINTER(*arg) = objects;
+    }
+  else
+    {
+      abort();
+    }
+}
+
+static void
+__make_gtk_object_mapper (gpointer data, gpointer user_data)
+{
+  Lisp_Object *rv = (Lisp_Object *) user_data;
+
+  *rv = Fcons (build_gtk_object (GTK_OBJECT (data)), *rv);
+}
+
+static void
+__make_string_mapper (gpointer data, gpointer user_data)
+{
+  Lisp_Object *rv = (Lisp_Object *) user_data;
+
+  *rv = Fcons (build_string ((char *)data), *rv);
+}
+
+static Lisp_Object
+xemacs_gtklist_to_list (GtkArg *arg)
+{
+  Lisp_Object rval = Qnil;
+
+  if (GTK_VALUE_POINTER (*arg))
+    {
+      if (arg->type == GTK_TYPE_STRING_LIST)
+       {
+         g_list_foreach (GTK_VALUE_POINTER (*arg), __make_string_mapper, &rval);
+       }
+      else if (arg->type == GTK_TYPE_OBJECT_LIST)
+       {
+         g_list_foreach (GTK_VALUE_POINTER (*arg), __make_gtk_object_mapper, &rval);
+       }
+      else
+       {
+         abort();
+       }
+    }
+  return (rval);
+}
+
+static void
+xemacs_list_to_array (Lisp_Object obj, GtkArg *arg)
+{
+  CHECK_LIST (obj);
+
+#define FROB(ret_type,check_fn,extract_fn) \
+  do {                                                         \
+    Lisp_Object temp = obj;                                    \
+    int length = 0;                                            \
+    ret_type *array = NULL;                                    \
+                                                               \
+    while (!NILP (temp))                                       \
+      {                                                                \
+       check_fn (XCAR (temp));                                 \
+       length++;                                               \
+       temp = XCDR (temp);                                     \
+      }                                                                \
+                                                               \
+    array = xnew_array_and_zero (ret_type, length + 2);                \
+    temp = obj;                                                        \
+    length = 0;                                                        \
+                                                               \
+    while (!NILP (temp))                                       \
+      {                                                                \
+       array[length++] = extract_fn (XCAR (temp));             \
+       temp = XCDR (temp);                                     \
+      }                                                                \
+                                                               \
+    GTK_VALUE_POINTER(*arg) = array;                           \
+  } while (0);
+  
+  if (arg->type == GTK_TYPE_STRING_ARRAY)
+    {
+      FROB(gchar *, CHECK_STRING, XSTRING_DATA);
+    }
+  else if (arg->type == GTK_TYPE_FLOAT_ARRAY)
+    {
+      FROB(gfloat, CHECK_FLOAT, extract_float);
+    }
+  else if (arg->type == GTK_TYPE_INT_ARRAY)
+    {
+      FROB(gint, CHECK_INT, XINT);
+    }
+  else
+    {
+      abort();
+    }
+#undef FROB
+}
+
+extern GdkGC *gtk_get_gc (struct device *d, Lisp_Object font, Lisp_Object fg, Lisp_Object bg,
+                         Lisp_Object bg_pmap, Lisp_Object lwidth);
+
+static GdkGC *
+face_to_gc (Lisp_Object face)
+{
+  Lisp_Object device = Fselected_device (Qnil);
+
+  return (gtk_get_gc (XDEVICE (device),
+                     Fspecifier_instance (Fget (face, Qfont, Qnil), device, Qnil, Qnil),
+                     Fspecifier_instance (Fget (face, Qforeground, Qnil), device, Qnil, Qnil),
+                     Fspecifier_instance (Fget (face, Qbackground, Qnil), device, Qnil, Qnil),
+                     Fspecifier_instance (Fget (face, Qbackground_pixmap, Qnil), device, Qnil, Qnil),
+                     Qnil));
+}
+
+static GtkStyle *
+face_to_style (Lisp_Object face)
+{
+  Lisp_Object device = Fselected_device (Qnil);
+  GtkStyle *style = gtk_style_new ();
+  int i;
+
+  Lisp_Object font = Fspecifier_instance (Fget (face, Qfont, Qnil), device, Qnil, Qnil);
+  Lisp_Object fg = Fspecifier_instance (Fget (face, Qforeground, Qnil), device, Qnil, Qnil);
+  Lisp_Object bg = Fspecifier_instance (Fget (face, Qbackground, Qnil), device, Qnil, Qnil);
+  Lisp_Object pm = Fspecifier_instance (Fget (face, Qbackground_pixmap, Qnil), device, Qnil, Qnil);
+
+  for (i = 0; i < 5; i++) style->fg[i] = * COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (fg));
+  for (i = 0; i < 5; i++) style->bg[i] = * COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (bg));
+
+  if (IMAGE_INSTANCEP (pm))
+    {
+      for (i = 0; i < 5; i++) style->bg_pixmap[i] = XIMAGE_INSTANCE_GTK_PIXMAP (pm);
+    }
+
+  style->font = FONT_INSTANCE_GTK_FONT (XFONT_INSTANCE (font));
+
+  return (style);
+}
+
+extern int gtk_event_to_emacs_event (struct frame *, GdkEvent *, struct Lisp_Event *);
+
+static Lisp_Object
+gdk_event_to_emacs_event(GdkEvent *ev)
+{
+  Lisp_Object emacs_event = Qnil;
+
+  if (ev)
+    {
+      emacs_event = Fmake_event (Qnil, Qnil);  
+      if (!gtk_event_to_emacs_event (NULL, ev, XEVENT (emacs_event)))
+       {
+         /* We need to handle a few more cases than the normal event
+         ** loop does.  Mainly the double/triple click events.
+         */
+         if ((ev->type == GDK_2BUTTON_PRESS) || (ev->type == GDK_3BUTTON_PRESS))
+           {
+             struct Lisp_Event *le = XEVENT (emacs_event);
+
+             le->event_type = misc_user_event;
+             le->event.misc.button = ev->button.button;
+             le->event.misc.modifiers = 0;
+             le->event.misc.x = ev->button.x;
+             le->event.misc.y = ev->button.y;
+             if (ev->type == GDK_2BUTTON_PRESS)
+               le->event.misc.function = intern ("double-click");
+             else
+               le->event.misc.function = intern ("triple-click");
+           }
+         else
+           {
+             Fdeallocate_event (emacs_event);
+             emacs_event = Qnil;
+           }
+       }
+    }
+  return (emacs_event);
+}

diff --git a/src/gtk-xemacs.c b/src/gtk-xemacs.c
new file mode 100644 (file)
index 0000000..15d15c0
--- /dev/null
+++ b/src/gtk-xemacs.c
@@ -0,0 +1,347 @@
+/* gtk-xemacs.c
+**
+** Description: A widget to encapsulate a XEmacs 'text widget'
+**
+** Created by: William M. Perry
+** Copyright (c) 2000 William M. Perry <wmperry@gnu.org>
+**
+*/
+
+#include <config.h>
+
+#include "lisp.h"
+#include "console-gtk.h"
+#include "objects-gtk.h"
+#include "gtk-xemacs.h"
+#include "window.h"
+#include "faces.h"
+
+extern Lisp_Object Vmodeline_face;
+extern Lisp_Object Vscrollbar_on_left_p;
+
+EXFUN (Fmake_image_instance, 4);
+
+static void gtk_xemacs_class_init      (GtkXEmacsClass *klass);
+static void gtk_xemacs_init            (GtkXEmacs *xemacs);
+static void gtk_xemacs_size_allocate   (GtkWidget *widget, GtkAllocation *allocaction);
+static void gtk_xemacs_draw            (GtkWidget *widget, GdkRectangle *area);
+static void gtk_xemacs_paint           (GtkWidget *widget, GdkRectangle *area);
+static void gtk_xemacs_size_request    (GtkWidget *widget, GtkRequisition *requisition);
+static void gtk_xemacs_realize         (GtkWidget *widget);
+static void gtk_xemacs_style_set        (GtkWidget *widget, GtkStyle *previous_style);
+static gint gtk_xemacs_expose          (GtkWidget *widget, GdkEventExpose *event);
+
+guint
+gtk_xemacs_get_type (void)
+{
+  static guint xemacs_type = 0;
+
+  if (!xemacs_type)
+    {
+      static const GtkTypeInfo xemacs_info =
+      {
+       "GtkXEmacs",
+       sizeof (GtkXEmacs),
+       sizeof (GtkXEmacsClass),
+       (GtkClassInitFunc) gtk_xemacs_class_init,
+       (GtkObjectInitFunc) gtk_xemacs_init,
+       /* reserved_1 */ NULL,
+        /* reserved_2 */ NULL,
+        (GtkClassInitFunc) NULL,
+      };
+
+      xemacs_type = gtk_type_unique (gtk_fixed_get_type (), &xemacs_info);
+    }
+
+  return xemacs_type;
+}
+
+static GtkWidgetClass *parent_class;
+
+extern gint emacs_gtk_button_event_handler(GtkWidget *widget, GdkEventButton *event);
+extern gint emacs_gtk_key_event_handler(GtkWidget *widget, GdkEventKey *event);
+extern gint emacs_gtk_motion_event_handler(GtkWidget *widget, GdkEventMotion *event);
+
+static void
+gtk_xemacs_class_init (GtkXEmacsClass *class)
+{
+  GtkWidgetClass *widget_class;
+
+  widget_class = (GtkWidgetClass*) class;
+  parent_class = (GtkWidgetClass *) gtk_type_class (gtk_fixed_get_type ());
+
+  widget_class->size_allocate = gtk_xemacs_size_allocate;
+  widget_class->size_request = gtk_xemacs_size_request;
+  widget_class->draw = gtk_xemacs_draw;
+  widget_class->expose_event = gtk_xemacs_expose;
+  widget_class->realize = gtk_xemacs_realize;
+  widget_class->button_press_event = emacs_gtk_button_event_handler;
+  widget_class->button_release_event = emacs_gtk_button_event_handler;
+  widget_class->key_press_event = emacs_gtk_key_event_handler;
+  widget_class->key_release_event = emacs_gtk_key_event_handler;
+  widget_class->motion_notify_event = emacs_gtk_motion_event_handler;
+  widget_class->style_set = gtk_xemacs_style_set;
+}
+
+static void
+gtk_xemacs_init (GtkXEmacs *xemacs)
+{
+    GTK_WIDGET_SET_FLAGS (xemacs, GTK_CAN_FOCUS);
+}
+
+GtkWidget*
+gtk_xemacs_new (struct frame *f)
+{
+  GtkXEmacs *xemacs;
+
+  xemacs = gtk_type_new (gtk_xemacs_get_type ());
+  xemacs->f = f;
+
+  return GTK_WIDGET (xemacs);
+}
+
+static void
+__nuke_background_items (GtkWidget *widget)
+{
+  /* This bit of voodoo is here to get around the annoying flicker
+     when GDK tries to futz with our background pixmap as well as
+     XEmacs doing it
+
+     We do NOT set the background of this widget window, that way
+     there is NO flickering, etc.  The downside is the XEmacs frame
+     appears as 'seethru' when XEmacs is too busy to redraw the
+     frame.
+
+     Well, wait, we do... otherwise there sre weird 'seethru' areas
+     even when XEmacs does a full redisplay.  Most noticable in some
+     areas of the modeline, or in the right-hand-side of the window
+     between the scrollbar ad n the edge of the window.
+  */
+  if (widget->window)
+    {
+      gdk_window_set_back_pixmap (widget->window, NULL, 0);
+      gdk_window_set_back_pixmap (widget->parent->window, NULL, 0);
+      gdk_window_set_background (widget->parent->window,
+                                &widget->style->bg[GTK_STATE_NORMAL]);
+      gdk_window_set_background (widget->window,
+                                &widget->style->bg[GTK_STATE_NORMAL]);
+    }
+}
+
+extern Lisp_Object xemacs_gtk_convert_color(GdkColor *c, GtkWidget *w);
+
+/* From objects-gtk.c */
+extern Lisp_Object __get_gtk_font_truename (GdkFont *gdk_font, int expandp);
+
+#define convert_font(f) __get_gtk_font_truename (f, 0)
+
+static void
+smash_face_fallbacks (struct frame *f, GtkStyle *style)
+{
+#define FROB(face,prop,slot) do {                                                      \
+                               Lisp_Object fallback = Qnil;                            \
+                               Lisp_Object specifier = Fget (face, prop, Qnil);        \
+                               struct Lisp_Specifier *sp = NULL;                       \
+                               if (NILP (specifier)) continue;                         \
+                               sp = XSPECIFIER (specifier);                            \
+                               fallback = sp->fallback;                                \
+                               if (EQ (Fcar (Fcar (Fcar (fallback))), Qgtk))           \
+                                       fallback = XCDR (fallback);                     \
+                               if (! NILP (slot))                                      \
+                                       fallback = acons (list1 (Qgtk),                 \
+                                                                 slot,                 \
+                                                                 fallback);            \
+                               set_specifier_fallback (specifier, fallback);           \
+                            } while (0);
+#define FROB_FACE(face,fg_slot,bg_slot) \
+do {                                                                                   \
+       FROB (face, Qforeground, xemacs_gtk_convert_color (&style->fg_slot[GTK_STATE_NORMAL], FRAME_GTK_SHELL_WIDGET (f)));     \
+       FROB (face, Qbackground, xemacs_gtk_convert_color (&style->bg_slot[GTK_STATE_NORMAL], FRAME_GTK_SHELL_WIDGET (f)));     \
+       if (style->rc_style && style->rc_style->bg_pixmap_name[GTK_STATE_NORMAL])       \
+       {                                                                               \
+               FROB (Vdefault_face, Qbackground_pixmap,                                \
+                       Fmake_image_instance (build_string (style->rc_style->bg_pixmap_name[GTK_STATE_NORMAL]), \
+                                         f->device, Qnil, make_int (5)));                      \
+       }                                                                               \
+       else                                                                            \
+       {                                                                               \
+               FROB (Vdefault_face, Qbackground_pixmap, Qnil);                         \
+       }                                                                               \
+} while (0)
+
+  FROB (Vdefault_face, Qfont, convert_font (style->font));
+  FROB_FACE (Vdefault_face, fg, bg);
+  FROB_FACE (Vgui_element_face, text, mid);
+
+#undef FROB
+#undef FROB_FACE
+}
+
+#ifdef HAVE_SCROLLBARS
+static void
+smash_scrollbar_specifiers (struct frame *f, GtkStyle *style)
+{
+  Lisp_Object frame;
+  int slider_size = 0;
+  int hsize, vsize;
+  GtkRangeClass *klass;
+
+  XSETFRAME (frame, f);
+
+  klass = (GtkRangeClass *) gtk_type_class (GTK_TYPE_SCROLLBAR);
+  slider_size = klass->slider_width;
+  hsize = slider_size + (style->klass->ythickness * 2);
+  vsize = slider_size + (style->klass->xthickness * 2);
+
+  style = gtk_style_attach (style,
+                           GTK_WIDGET (DEVICE_GTK_APP_SHELL (XDEVICE (FRAME_DEVICE (f))))->window);
+
+  Fadd_spec_to_specifier (Vscrollbar_width, make_int (vsize), frame, Qnil, Qnil);
+  Fadd_spec_to_specifier (Vscrollbar_height, make_int (hsize), frame, Qnil, Qnil);
+}
+#else
+#define smash_scrollbar_specifiers(x,y)
+#endif /* HAVE_SCROLLBARS */
+
+static void
+gtk_xemacs_realize (GtkWidget *widget)
+{
+  parent_class->realize (widget);
+  gtk_xemacs_style_set (widget, gtk_widget_get_style (widget));
+}
+
+static void
+gtk_xemacs_style_set (GtkWidget *widget, GtkStyle *previous_style)
+{
+  GtkStyle *new_style = gtk_widget_get_style (widget);
+  GtkXEmacs *x = GTK_XEMACS (widget);
+
+  parent_class->style_set (widget, previous_style);
+
+  if (x->f)
+    {
+      __nuke_background_items (widget);
+#if 0
+      smash_face_fallbacks (x->f, new_style);
+#endif
+      smash_scrollbar_specifiers (x->f, new_style);
+    }
+}
+
+static void
+gtk_xemacs_size_request (GtkWidget *widget, GtkRequisition *requisition)
+{
+    GtkXEmacs *x = GTK_XEMACS (widget);
+    struct frame *f = GTK_XEMACS_FRAME (x);
+    int width, height;
+
+    if (f)
+      {
+       char_to_pixel_size (f, FRAME_WIDTH (f), FRAME_HEIGHT (f),
+                           &width, &height);
+       requisition->width = width;
+       requisition->height = height;
+      }
+    else
+      {
+       parent_class->size_request (widget, requisition);
+      }
+}
+
+static void
+gtk_xemacs_size_allocate (GtkWidget *widget, GtkAllocation *allocation)
+{
+    GtkXEmacs *x = GTK_XEMACS (widget);
+    struct frame *f = GTK_XEMACS_FRAME (x);
+    int columns, rows;
+
+    parent_class->size_allocate(widget, allocation);
+
+    if (f)
+      {
+       f->pixwidth = allocation->width;
+       f->pixheight = allocation->height;
+
+       pixel_to_char_size (f,
+                           allocation->width,
+                           allocation->height, &columns, &rows);
+
+       change_frame_size (f, rows, columns, 1);
+      }
+}
+
+static void
+gtk_xemacs_paint (GtkWidget *widget, GdkRectangle *area)
+{
+    GtkXEmacs *x = GTK_XEMACS (widget);
+    struct frame *f = GTK_XEMACS_FRAME (x);
+    gtk_redraw_exposed_area (f, area->x, area->y, area->width, area->height);
+}
+
+static void
+gtk_xemacs_draw (GtkWidget *widget, GdkRectangle *area)
+{
+    GtkFixed *fixed = GTK_FIXED (widget);
+    GtkFixedChild *child;
+    GdkRectangle child_area;
+    GList *children;
+
+    /* I need to manually iterate over the children instead of just
+       chaining to parent_class->draw() because it calls
+       gtk_fixed_paint() directly, which clears the background window,
+       which causes A LOT of flashing. */
+
+    gtk_xemacs_paint (widget, area);
+
+    children = fixed->children;
+
+    while (children)
+      {
+       child = children->data;
+       children = children->next;
+       /* #### This is what causes the scrollbar flickering!
+          Evidently the scrollbars pretty much take care of drawing
+          themselves in most cases.  Then we come along and tell them
+          to redraw again!
+
+          But if we just leave it out, then they do not get drawn
+          correctly the first time!
+
+          Scrollbar flickering has been greatly helped by the
+          optimizations in scrollbar-gtk.c /
+          gtk_update_scrollbar_instance_status (), so this is not that
+          big a deal anymore.
+       */
+       if (gtk_widget_intersect (child->widget, area, &child_area))
+         {
+           gtk_widget_draw (child->widget, &child_area);
+         }
+      }
+}
+
+static gint
+gtk_xemacs_expose (GtkWidget *widget, GdkEventExpose *event)
+{
+    GtkXEmacs *x = GTK_XEMACS (widget);
+    struct frame *f = GTK_XEMACS_FRAME (x);
+    GdkRectangle *a = &event->area;
+
+    /* This takes care of drawing the scrollbars, etc */
+    parent_class->expose_event (widget, event);
+
+    /* Now draw the actual frame data */
+    if (!check_for_ignored_expose (f, a->x, a->y, a->width, a->height) &&
+       !find_matching_subwindow (f, a->x, a->y, a->width, a->height))
+      gtk_redraw_exposed_area (f, a->x, a->y, a->width, a->height);
+    return (TRUE);
+}
+
+Lisp_Object
+xemacs_gtk_convert_color(GdkColor *c, GtkWidget *w)
+{
+  char color_buf[255];
+
+  sprintf (color_buf, "#%04x%04x%04x", c->red, c->green, c->blue);
+
+  return (build_string (color_buf));
+}

diff --git a/src/gtk-xemacs.h b/src/gtk-xemacs.h
new file mode 100644 (file)
index 0000000..5357f0c
--- /dev/null
+++ b/src/gtk-xemacs.h
@@ -0,0 +1,48 @@
+/* gtk-xemacs.h
+**
+** Description: A widget to encapsulate a XEmacs 'text widget'
+**
+** Created by: William M. Perry
+** Copyright (c) 2000 William M. Perry <wmperry@gnu.org>
+**
+*/
+
+#ifndef __GTK_XEMACS_H__
+#define __GTK_XEMACS_H__
+
+#include <config.h>
+#include "frame.h"
+#include <gdk/gdk.h>
+#include <gtk/gtkfixed.h>
+
+#ifdef __cplusplus
+extern "C" {
+#endif /* __cplusplus */
+
+#define GTK_XEMACS(obj)                        GTK_CHECK_CAST (obj, gtk_xemacs_get_type (), GtkXEmacs)
+#define GTK_XEMACS_CLASS(klass)        GTK_CHECK_CLASS_CAST (klass, gtk_xemacs_get_type (), GtkXEmacsClass)
+#define GTK_IS_XEMACS(obj)             GTK_CHECK_TYPE (obj, gtk_xemacs_get_type ())
+#define GTK_XEMACS_FRAME(obj)  GTK_XEMACS (obj)->f
+
+       typedef struct _GtkXEmacs GtkXEmacs;
+       typedef struct _GtkXEmacsClass GtkXEmacsClass;
+
+       struct _GtkXEmacs
+       {
+               GtkFixed fixed;
+               struct frame *f;
+       };
+
+       struct _GtkXEmacsClass
+       {
+               GtkFixedClass parent_class;
+       };
+
+       guint gtk_xemacs_get_type (void);
+       GtkWidget *gtk_xemacs_new (struct frame *f);
+
+#ifdef __cplusplus
+}
+#endif /* __cplusplus */
+
+#endif /* __GTK_XEMACS_H__ */

diff --git a/src/gui-gtk.c b/src/gui-gtk.c
new file mode 100644 (file)
index 0000000..d772eae
--- /dev/null
+++ b/src/gui-gtk.c
@@ -0,0 +1,108 @@
+/* General GUI code -- X-specific. (menubars, scrollbars, toolbars, dialogs)
+   Copyright (C) 1995 Board of Trustees, University of Illinois.
+   Copyright (C) 1995, 1996 Ben Wing.
+   Copyright (C) 1995 Sun Microsystems, Inc.
+   Copyright (C) 1998 Free Software Foundation, Inc.
+
+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, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with: Not in FSF. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "console-gtk.h"
+#include "gui-gtk.h"
+#include "buffer.h"
+#include "device.h"
+#include "frame.h"
+#include "gui.h"
+#include "opaque.h"
+
+#ifdef HAVE_POPUPS
+Lisp_Object Qmenu_no_selection_hook;
+#endif
+
+static GUI_ID gui_id_ctr = 0;
+
+GUI_ID
+new_gui_id (void)
+{
+  return (++gui_id_ctr);
+}
+
+/* This is like FRAME_MENUBAR_DATA (f), but contains an alist of
+   (id . popup-data) for GCPRO'ing the callbacks of the popup menus
+   and dialog boxes. */
+static Lisp_Object Vpopup_callbacks;
+
+void
+gcpro_popup_callbacks (GUI_ID id, Lisp_Object data)
+{
+  Vpopup_callbacks = Fcons (Fcons (make_int (id), data), Vpopup_callbacks);
+}
+
+void
+ungcpro_popup_callbacks (GUI_ID id)
+{
+  Lisp_Object lid = make_int (id);
+  Lisp_Object this = assq_no_quit (lid, Vpopup_callbacks);
+  Vpopup_callbacks = delq_no_quit (this, Vpopup_callbacks);
+}
+
+Lisp_Object
+get_gcpro_popup_callbacks (GUI_ID id)
+{
+  Lisp_Object lid = make_int (id);
+  Lisp_Object this = assq_no_quit (lid, Vpopup_callbacks);
+
+  if (!NILP (this))
+    {
+      return (XCDR (this));
+    }
+  return (Qnil);
+}
+
+void
+syms_of_gui_gtk (void)
+{
+#ifdef HAVE_POPUPS
+  defsymbol (&Qmenu_no_selection_hook, "menu-no-selection-hook");
+#endif
+}
+
+void
+vars_of_gui_gtk (void)
+{
+  staticpro (&Vpopup_callbacks);
+  Vpopup_callbacks = Qnil;
+#ifdef HAVE_POPUPS
+  popup_up_p = 0;
+
+#if 0
+  /* This DEFVAR_LISP is just for the benefit of make-docfile. */
+  /* #### misnamed */
+  DEFVAR_LISP ("menu-no-selection-hook", &Vmenu_no_selection_hook /*
+Function or functions to call when a menu or dialog box is dismissed
+without a selection having been made.
+*/ );
+#endif
+
+  Fset (Qmenu_no_selection_hook, Qnil);
+#endif /* HAVE_POPUPS */
+}

diff --git a/src/gui-gtk.h b/src/gui-gtk.h
new file mode 100644 (file)
index 0000000..9fb38eb
--- /dev/null
+++ b/src/gui-gtk.h
@@ -0,0 +1,36 @@
+/* General GUI code -- X-specific header file.
+   Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+   Copyright (C) 1996 Ben Wing.
+
+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, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with: Not in FSF. */
+
+#ifndef _XEMACS_GUI_GTK_H_
+#define _XEMACS_GUI_GTK_H_
+
+#include <gtk/gtk.h>
+
+typedef unsigned int GUI_ID;
+extern GUI_ID new_gui_id (void);
+
+extern void gcpro_popup_callbacks (GUI_ID id, Lisp_Object data);
+extern void ungcpro_popup_callbacks (GUI_ID id);
+extern Lisp_Object get_gcpro_popup_callbacks (GUI_ID id);
+
+#endif /* _XEMACS_GUI_GTK_H_ */

diff --git a/src/menubar-gtk.c b/src/menubar-gtk.c
new file mode 100644 (file)
index 0000000..8d2dac9
--- /dev/null
+++ b/src/menubar-gtk.c
@@ -0,0 +1,1305 @@
+/* Implements an elisp-programmable menubar -- X interface.
+   Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+   Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
+
+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, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with: Not in FSF. */
+
+/* created 16-dec-91 by jwz */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "console-gtk.h"
+#include "gui-gtk.h"
+
+#include "buffer.h"
+#include "commands.h"           /* zmacs_regions */
+#include "ui-gtk.h"
+#include "gui.h"
+#include "events.h"
+#include "frame.h"
+#include "opaque.h"
+#include "window.h"
+
+#ifdef HAVE_GNOME
+#include <libgnomeui/libgnomeui.h>
+#endif
+
+#define MENUBAR_TYPE   0
+#define SUBMENU_TYPE   1
+#define POPUP_TYPE     2
+
+static GtkWidget *menu_descriptor_to_widget_1 (Lisp_Object descr);
+
+#define FRAME_MENUBAR_DATA(frame) ((frame)->menubar_data)
+#define XFRAME_MENUBAR_DATA_LASTBUFF(frame) (XCAR ((frame)->menubar_data))
+#define XFRAME_MENUBAR_DATA_UPTODATE(frame) (XCDR ((frame)->menubar_data))
+
+\f
+/* This is a bogus subclass of GtkMenuBar so that the menu never tries
+** to be bigger than the text widget.  This prevents weird resizing
+** when jumping around between buffers with radically different menu
+** sizes.
+*/
+
+#define GTK_XEMACS_MENUBAR(obj)                GTK_CHECK_CAST (obj, gtk_xemacs_menubar_get_type (), GtkXEmacsMenubar)
+#define GTK_XEMACS_MENUBAR_CLASS(klass)        GTK_CHECK_CLASS_CAST (klass, gtk_xemacs_menubar_get_type (), GtkXEmacsMenubarClass)
+#define GTK_IS_XEMACS_MENUBAR(obj)     GTK_CHECK_TYPE (obj, gtk_xemacs_menubar_get_type ())
+#define GTK_XEMACS_MENUBAR_FRAME(obj)  GTK_XEMACS_MENUBAR (obj)->f
+
+typedef struct _GtkXEmacsMenubar GtkXEmacsMenubar;
+typedef struct _GtkXEmacsMenubarClass GtkXEmacsMenubarClass;
+
+struct _GtkXEmacsMenubar
+{
+  GtkMenuBar menu;
+  struct frame *frame;
+};
+
+struct _GtkXEmacsMenubarClass
+{
+  GtkMenuBarClass parent_class;
+};
+
+guint gtk_xemacs_menubar_get_type (void);
+GtkWidget *gtk_xemacs_menubar_new (struct frame *f);
+
+static void gtk_xemacs_menubar_class_init      (GtkXEmacsMenubarClass *klass);
+static void gtk_xemacs_menubar_init            (GtkXEmacsMenubar *xemacs);
+static void gtk_xemacs_menubar_size_request    (GtkWidget *widget, GtkRequisition *requisition);
+
+guint
+gtk_xemacs_menubar_get_type (void)
+{
+  static guint xemacs_menubar_type;
+
+  if (!xemacs_menubar_type)
+    {
+      static const GtkTypeInfo xemacs_menubar_info =
+      {
+       "GtkXEmacsMenubar",
+       sizeof (GtkXEmacsMenubar),
+       sizeof (GtkXEmacsMenubarClass),
+       (GtkClassInitFunc) gtk_xemacs_menubar_class_init,
+       (GtkObjectInitFunc) gtk_xemacs_menubar_init,
+       /* reserved_1 */ NULL,
+        /* reserved_2 */ NULL,
+        (GtkClassInitFunc) NULL,
+      };
+
+      xemacs_menubar_type = gtk_type_unique (gtk_menu_bar_get_type (), &xemacs_menubar_info);
+    }
+
+  return xemacs_menubar_type;
+}
+
+static GtkWidgetClass *parent_class;
+
+static void gtk_xemacs_menubar_class_init      (GtkXEmacsMenubarClass *klass)
+{
+  GtkWidgetClass *widget_class;
+
+  widget_class = (GtkWidgetClass*) klass;
+  parent_class = (GtkWidgetClass *) gtk_type_class (gtk_menu_bar_get_type ());
+
+  widget_class->size_request = gtk_xemacs_menubar_size_request;
+}
+
+static void gtk_xemacs_menubar_init            (GtkXEmacsMenubar *xemacs)
+{
+}
+
+static void gtk_xemacs_menubar_size_request    (GtkWidget *widget, GtkRequisition *requisition)
+{
+  GtkXEmacsMenubar *x = GTK_XEMACS_MENUBAR (widget);
+  GtkRequisition frame_size;
+
+  parent_class->size_request (widget, requisition);
+
+  /* #### BILL!
+  ** We should really only do this if the menu has not been detached!
+  **
+  ** WMP 9/9/2000
+  */
+
+  gtk_widget_size_request (FRAME_GTK_TEXT_WIDGET (x->frame), &frame_size);
+
+  requisition->width = frame_size.width;
+}
+
+GtkWidget *
+gtk_xemacs_menubar_new (struct frame *f)
+{
+  GtkXEmacsMenubar *menubar = gtk_type_new (gtk_xemacs_menubar_get_type ());
+
+  menubar->frame = f;
+
+  return (GTK_WIDGET (menubar));
+}
+\f
+/* We now return you to your regularly scheduled menus... */
+
+int dockable_menubar;
+
+/* #define TEAR_OFF_MENUS */
+
+#ifdef TEAR_OFF_MENUS
+int tear_off_menus;
+#endif
+
+\f
+/* Converting from XEmacs to GTK representation */
+static Lisp_Object
+menu_name_to_accelerator (char *name)
+{
+  while (*name) {
+    if (*name=='%') {
+      ++name;
+      if (!(*name))
+       return Qnil;
+      if (*name=='_' && *(name+1))
+       {
+         int accelerator = (int) (unsigned char) (*(name+1));
+         return make_char (tolower (accelerator));
+       }
+    }
+    ++name;
+  }
+  return Qnil;
+}
+
+#define XEMACS_MENU_DESCR_TAG "xemacs::menu::description"
+#define XEMACS_MENU_FILTER_TAG "xemacs::menu::filter"
+#define XEMACS_MENU_GUIID_TAG "xemacs::menu::gui_id"
+#define XEMACS_MENU_FIRSTTIME_TAG "xemacs::menu::first_time"
+
+static void __activate_menu(GtkMenuItem *, gpointer);
+
+#ifdef TEAR_OFF_MENUS
+static void
+__torn_off_sir(GtkMenuItem *item, gpointer user_data)
+{
+  GtkWidget *menu_item = GTK_WIDGET (user_data);
+
+  if (GTK_TEAROFF_MENU_ITEM (item)->torn_off)
+    {
+      /* Menu was just torn off */
+      GUI_ID id = new_gui_id ();
+      Lisp_Object menu_desc = Qnil;
+      GtkWidget *old_submenu = GTK_MENU_ITEM (menu_item)->submenu;
+
+      VOID_TO_LISP (menu_desc, gtk_object_get_data (GTK_OBJECT (menu_item), XEMACS_MENU_DESCR_TAG));
+
+      /* GCPRO all of our very own */
+      gcpro_popup_callbacks (id, menu_desc);
+
+      /* Hide the now detached menu from the attentions of
+         __activate_menu destroying the old submenu */
+#if 0
+      gtk_widget_ref (old_submenu);
+      gtk_menu_item_set_submenu (GTK_MENU_ITEM (menu_item), gtk_menu_new ());
+      gtk_widget_show_all (old_submenu);
+#endif
+    }
+}
+#endif
+
+/* This is called when a menu is about to be shown... this is what
+   does the delayed creation of the menu items.  We populate the
+   submenu and away we go. */
+static void
+__maybe_destroy (GtkWidget *child, GtkWidget *precious)
+{
+  if (GTK_IS_MENU_ITEM (child) && !GTK_IS_TEAROFF_MENU_ITEM (child))
+    {
+      if (GTK_WIDGET_VISIBLE (child))
+       {
+         /* If we delete the menu item that was 'active' when the
+            menu was cancelled, GTK gets upset because it tries to
+            remove the focus rectangle from a (now) dead widget.
+
+            This widget will eventually get killed because it will
+            not be visible the next time the window is shown.
+         */
+         gtk_widget_set_sensitive (child, FALSE);
+         gtk_widget_hide_all (child);
+       }
+      else
+       {
+         gtk_widget_destroy (child);
+       }
+    }
+}
+
+/* If user_data != 0x00 then we are using a hook to build the menu. */
+static void
+__activate_menu(GtkMenuItem *item, gpointer user_data)
+{
+  Lisp_Object desc;
+  gpointer force_clear = gtk_object_get_data (GTK_OBJECT (item), XEMACS_MENU_FIRSTTIME_TAG);
+
+  gtk_object_set_data (GTK_OBJECT (item), XEMACS_MENU_FIRSTTIME_TAG, 0x00);
+
+  /* Delete the old contents of the menu if we are the top level menubar */
+  if (GTK_IS_MENU_BAR (GTK_WIDGET (item)->parent) || force_clear)
+    {
+      GtkWidget *selected = gtk_menu_get_active (GTK_MENU (item->submenu));
+
+      gtk_container_foreach (GTK_CONTAINER (item->submenu),(GtkCallback) __maybe_destroy,
+                            selected);
+    }
+  else if (gtk_container_children (GTK_CONTAINER (item->submenu)))
+    {
+      return;
+    }
+
+  VOID_TO_LISP (desc, gtk_object_get_data (GTK_OBJECT (item), XEMACS_MENU_DESCR_TAG));
+
+#ifdef TEAR_OFF_MENUS
+  /* Lets stick in a detacher just for giggles */
+  if (tear_off_menus && !gtk_container_children (GTK_CONTAINER (item->submenu)))
+  {
+    GtkWidget *w = gtk_tearoff_menu_item_new ();
+    gtk_widget_show (w);
+    gtk_menu_append (GTK_MENU (item->submenu), w);
+    gtk_signal_connect (GTK_OBJECT (w), "activate", GTK_SIGNAL_FUNC (__torn_off_sir), item);
+  }
+#endif
+
+  if (user_data)
+    {
+      GUI_ID id = (GUI_ID) gtk_object_get_data (GTK_OBJECT (item), XEMACS_MENU_GUIID_TAG);
+      Lisp_Object hook_fn;
+      struct gcpro gcpro1, gcpro2;
+
+      VOID_TO_LISP (hook_fn, gtk_object_get_data (GTK_OBJECT (item), XEMACS_MENU_FILTER_TAG));
+
+      GCPRO2 (desc, hook_fn);
+
+      desc = call1 (hook_fn, desc);
+
+      UNGCPRO;
+
+      ungcpro_popup_callbacks (id);
+      gcpro_popup_callbacks (id, desc);
+    }
+
+  /* Build the child widgets */
+  for (; !NILP (desc); desc = Fcdr (desc))
+    {
+      GtkWidget *next = NULL;
+      Lisp_Object child = Fcar (desc);
+
+      if (NILP (child))        /* the partition */
+       {
+         /* Signal an error here?  The NILP handling is handled a
+             layer higher where appropriate */
+       }
+      else
+       {
+         next = menu_descriptor_to_widget_1 (child);
+       }
+
+      if (!next)
+       {
+         continue;
+       }
+
+      gtk_widget_show_all (next);
+      gtk_menu_append (GTK_MENU (item->submenu), next);
+    }
+}
+
+/* This is called whenever an item with a GUI_ID associated with it is
+   destroyed.  This allows us to remove the references in gui-gtk.c
+   that made sure callbacks and such were GCPRO-ed
+*/
+static void
+__remove_gcpro_by_id (gpointer user_data)
+{
+  ungcpro_popup_callbacks ((GUI_ID) user_data);
+}
+
+static void
+__kill_stupid_gtk_timer (GtkObject *obj, gpointer user_data)
+{
+  GtkMenuItem *mi = GTK_MENU_ITEM (obj);
+
+  if (mi->timer)
+    {
+      gtk_timeout_remove (mi->timer);
+      mi->timer = 0;
+    }
+}
+
+static char *
+remove_underscores(const char *name)
+{
+  char *rval = xmalloc_and_zero (strlen(name) + 1);
+  int i,j;
+
+  for (i = 0, j = 0; name[i]; i++)
+    {
+      if (name[i]=='%') {
+       i++;
+       if (!(name[i]))
+         continue;
+
+       if ((name[i] == '_'))
+         continue;
+      }
+      rval[j++] = name[i];
+    }
+  return rval;
+}
+
+/* This converts an entire menu into a GtkMenuItem (with an attached
+   submenu).  A menu is a list of (STRING [:keyword value]+ [DESCR]+)
+   DESCR is either a list (meaning a submenu), a vector, or nil (if
+   you include a :filter keyword) */
+static GtkWidget *
+menu_convert (Lisp_Object desc, GtkWidget *reuse)
+{
+  GtkWidget *menu_item = NULL;
+  GtkWidget *submenu = NULL;
+  Lisp_Object key, val;
+  Lisp_Object include_p = Qnil, hook_fn = Qnil, config_tag = Qnil;
+  Lisp_Object active_p = Qt;
+  Lisp_Object accel;
+  int included_spec = 0;
+  int active_spec = 0;
+
+  if (STRINGP (XCAR (desc)))
+    {
+      accel = menu_name_to_accelerator (XSTRING_DATA (XCAR (desc)));
+
+      if (!reuse)
+       {
+         char *temp_menu_name = remove_underscores (XSTRING_DATA (XCAR (desc)));
+         menu_item = gtk_menu_item_new_with_label (temp_menu_name);
+         free (temp_menu_name);
+       }
+      else
+       {
+         menu_item = reuse;
+       }
+
+      submenu = gtk_menu_new ();
+      gtk_widget_show (menu_item);
+      gtk_widget_show (submenu);
+
+      if (!reuse)
+       gtk_signal_connect (GTK_OBJECT (menu_item), "destroy",
+                           GTK_SIGNAL_FUNC (__kill_stupid_gtk_timer), NULL);
+
+      /* Without this sometimes a submenu gets left on the screen -
+      ** urk
+      */
+      if (GTK_MENU_ITEM (menu_item)->submenu)
+       {
+         gtk_widget_destroy (GTK_MENU_ITEM (menu_item)->submenu);
+       }
+
+      gtk_menu_item_set_submenu (GTK_MENU_ITEM (menu_item), submenu);
+
+      /* We put this bogus menu item in so that GTK does the right
+      ** thing when the menu is near the screen border.
+      **
+      ** Aug 29, 2000
+      */
+      {
+       GtkWidget *bogus_item = gtk_menu_item_new_with_label ("A suitably long label here...");
+
+       gtk_object_set_data (GTK_OBJECT (menu_item), XEMACS_MENU_FIRSTTIME_TAG, (gpointer)0x01);
+       gtk_widget_show_all (bogus_item);
+       gtk_menu_append (GTK_MENU (submenu), bogus_item);
+      }
+
+      desc = Fcdr (desc);
+
+      while (key = Fcar (desc), KEYWORDP (key))
+       {
+         Lisp_Object cascade = desc;
+         desc = Fcdr (desc);
+         if (NILP (desc))
+           signal_simple_error ("keyword in menu lacks a value",
+                                cascade);
+         val = Fcar (desc);
+         desc = Fcdr (desc);
+         if (EQ (key, Q_included))
+           include_p = val, included_spec = 1;
+         else if (EQ (key, Q_config))
+           config_tag = val;
+         else if (EQ (key, Q_filter))
+           hook_fn = val;
+         else if (EQ (key, Q_active))
+           active_p = val, active_spec = 1;
+         else if (EQ (key, Q_accelerator))
+           {
+#if 0
+             if ( SYMBOLP (val)
+                  || CHARP (val))
+               wv->accel = LISP_TO_VOID (val);
+             else
+               signal_simple_error ("bad keyboard accelerator", val);
+#endif
+           }
+         else if (EQ (key, Q_label))
+           {
+             /* implement in 21.2 */
+           }
+         else
+           signal_simple_error ("unknown menu cascade keyword", cascade);
+       }
+
+      gtk_object_set_data (GTK_OBJECT (menu_item), XEMACS_MENU_DESCR_TAG, LISP_TO_VOID (desc));
+      gtk_object_set_data (GTK_OBJECT (menu_item), XEMACS_MENU_FILTER_TAG, LISP_TO_VOID (hook_fn));
+
+      if ((!NILP (config_tag)
+          && NILP (Fmemq (config_tag, Vmenubar_configuration)))
+         || (included_spec && NILP (Feval (include_p))))
+       {
+         return (NULL);
+       }
+
+      if (active_spec)
+       active_p = Feval (active_p);
+
+      gtk_widget_set_sensitive (GTK_WIDGET (menu_item), ! NILP (active_p));
+    }
+  else
+    {
+      signal_simple_error ("menu name (first element) must be a string",
+                          desc);
+    }
+
+  /* If we are reusing a widget, we need to make sure we clean
+  ** everything up.
+  */
+  if (reuse)
+    {
+      gpointer id = gtk_object_get_data (GTK_OBJECT (reuse), XEMACS_MENU_GUIID_TAG);
+
+      if (id)
+       {
+         /* If the menu item had a GUI_ID that means it was a filter menu */
+         __remove_gcpro_by_id (id);
+         gtk_signal_disconnect_by_func (GTK_OBJECT (reuse),
+                                        GTK_SIGNAL_FUNC (__activate_menu),
+                                        (gpointer) 0x01 );
+       }
+      else
+       {
+         gtk_signal_disconnect_by_func (GTK_OBJECT (reuse),
+                                        GTK_SIGNAL_FUNC (__activate_menu),
+                                        NULL);
+       }
+
+      GTK_MENU_ITEM (reuse)->right_justify = 0;
+    }
+
+  if (NILP (hook_fn))
+    {
+      /* Generic menu builder */
+      gtk_signal_connect (GTK_OBJECT (menu_item), "activate",
+                         GTK_SIGNAL_FUNC (__activate_menu),
+                         NULL);
+    }
+  else
+    {
+      GUI_ID id = new_gui_id ();
+
+      gtk_object_set_data (GTK_OBJECT (menu_item), XEMACS_MENU_GUIID_TAG,
+                          (gpointer) id);
+
+      /* Make sure we gcpro the menu descriptions */
+      gcpro_popup_callbacks (id, desc);
+      gtk_object_weakref (GTK_OBJECT (menu_item), __remove_gcpro_by_id,
+                         (gpointer) id);
+
+      gtk_signal_connect (GTK_OBJECT (menu_item), "activate",
+                         GTK_SIGNAL_FUNC (__activate_menu),
+                         (gpointer) 0x01);
+    }
+
+  return (menu_item);
+}
+
+static struct frame *
+__get_channel (GtkWidget *w)
+{
+  struct frame *f = NULL;
+
+  for (; w; w = w->parent)
+    {
+      if ((f = (struct frame *) gtk_object_get_data (GTK_OBJECT (w), "xemacs::frame")))
+       return (f);
+    }
+
+  return (selected_frame());
+}
+
+
+/* Called whenever a button, radio, or toggle is selected in the menu */
+static void
+__generic_button_callback (GtkMenuItem *item, gpointer user_data)
+{
+  Lisp_Object callback, function, data, channel;
+
+  XSETFRAME (channel, __get_channel (GTK_WIDGET (item)));
+
+  VOID_TO_LISP (callback, user_data);
+
+  get_gui_callback (callback, &function, &data);
+
+  signal_special_gtk_user_event (channel, function, data);
+}
+
+/* Convert a single menu item descriptor to a suitable GtkMenuItem */
+/* This function cannot GC.
+   It is only called from menu_item_descriptor_to_widget_value, which
+   prohibits GC. */
+static GtkWidget *menu_descriptor_to_widget_1 (Lisp_Object descr)
+{
+  if (STRINGP (descr))
+    {
+      /* It is a separator.  Unfortunately GTK does not allow us to
+         specify what our separators look like, so we can't do all the
+         fancy stuff that the X code does.
+      */
+      return (gtk_menu_item_new ());
+    }
+  else if (LISTP (descr))
+    {
+      /* It is a submenu */
+      return (menu_convert (descr, NULL));
+    }
+  else if (VECTORP (descr))
+    {
+      /* An actual menu item description!  This gets yucky. */
+      Lisp_Object name       = Qnil;
+      Lisp_Object callback   = Qnil;
+      Lisp_Object suffix     = Qnil;
+      Lisp_Object active_p   = Qt;
+      Lisp_Object include_p  = Qt;
+      Lisp_Object selected_p = Qnil;
+      Lisp_Object keys       = Qnil;
+      Lisp_Object style      = Qnil;
+      Lisp_Object config_tag = Qnil;
+      Lisp_Object accel = Qnil;
+      GtkWidget *main_label = NULL;
+      int length = XVECTOR_LENGTH (descr);
+      Lisp_Object *contents = XVECTOR_DATA (descr);
+      int plist_p;
+      int selected_spec = 0, included_spec = 0;
+      GtkWidget *widget = NULL;
+
+      if (length < 2)
+       signal_simple_error ("button descriptors must be at least 2 long", descr);
+
+      /* length 2:             [ "name" callback ]
+        length 3:              [ "name" callback active-p ]
+        length 4:              [ "name" callback active-p suffix ]
+        or                     [ "name" callback keyword  value  ]
+        length 5+:             [ "name" callback [ keyword value ]+ ]
+      */
+      plist_p = (length >= 5 || (length > 2 && KEYWORDP (contents [2])));
+      
+      if (!plist_p && length > 2)
+       /* the old way */
+       {
+         name = contents [0];
+         callback = contents [1];
+         active_p = contents [2];
+         if (length == 4)
+           suffix = contents [3];
+       }
+      else
+       {
+         /* the new way */
+         int i;
+         if (length & 1)
+           signal_simple_error (
+                                "button descriptor has an odd number of keywords and values",
+                                descr);
+
+         name = contents [0];
+         callback = contents [1];
+         for (i = 2; i < length;)
+           {
+             Lisp_Object key = contents [i++];
+             Lisp_Object val = contents [i++];
+             if (!KEYWORDP (key))
+               signal_simple_error_2 ("not a keyword", key, descr);
+
+             if      (EQ (key, Q_active))   active_p   = val;
+             else if (EQ (key, Q_suffix))   suffix     = val;
+             else if (EQ (key, Q_keys))     keys       = val;
+             else if (EQ (key, Q_key_sequence))  ; /* ignored for FSF compat */
+             else if (EQ (key, Q_label))  ; /* implement for 21.0 */
+             else if (EQ (key, Q_style))    style      = val;
+             else if (EQ (key, Q_selected)) selected_p = val, selected_spec = 1;
+             else if (EQ (key, Q_included)) include_p  = val, included_spec = 1;
+             else if (EQ (key, Q_config))       config_tag = val;
+             else if (EQ (key, Q_accelerator))
+               {
+                 if ( SYMBOLP (val) || CHARP (val))
+                   accel = val;
+                 else
+                   signal_simple_error ("bad keyboard accelerator", val);
+               }
+             else if (EQ (key, Q_filter))
+               signal_simple_error(":filter keyword not permitted on leaf nodes", descr);
+             else
+               signal_simple_error_2 ("unknown menu item keyword", key, descr);
+           }
+       }
+
+#ifdef HAVE_MENUBARS
+      if ((!NILP (config_tag) && NILP (Fmemq (config_tag, Vmenubar_configuration)))
+         || (included_spec && NILP (Feval (include_p))))
+       {
+         /* the include specification says to ignore this item. */
+         return 0;
+       }
+#endif /* HAVE_MENUBARS */
+
+      CHECK_STRING (name);
+
+      if (NILP (accel))
+       accel = menu_name_to_accelerator (XSTRING_DATA (name));
+
+      if (!NILP (suffix))
+       suffix = Feval (suffix);
+
+      if (!separator_string_p (XSTRING_DATA (name)))
+       {
+         char *label_buffer = NULL;
+         char *temp_label = NULL;
+
+         if (STRINGP (suffix) && XSTRING_LENGTH (suffix))
+           {
+             label_buffer = alloca (XSTRING_LENGTH (name) + 15 + XSTRING_LENGTH (suffix));
+             sprintf (label_buffer, "%s %s ", XSTRING_DATA (name), XSTRING_DATA (suffix));
+           }
+         else
+           {
+             label_buffer = alloca (XSTRING_LENGTH (name) + 15);
+             sprintf (label_buffer, "%s ", XSTRING_DATA (name));
+           }
+
+         temp_label = remove_underscores (label_buffer);
+         main_label = gtk_accel_label_new (temp_label);
+         free (temp_label);
+       }
+
+      /* Evaluate the selected and active items now */
+      if (selected_spec)
+       {
+         if (NILP (selected_p) || EQ (selected_p, Qt))
+           {
+             /* Do nothing */
+           }
+         else
+           {
+             selected_p = Feval (selected_p);
+           }
+       }
+
+      if (NILP (active_p) || EQ (active_p, Qt))
+       {
+         /* Do Nothing */
+       }
+      else
+       {
+         active_p = Feval (active_p);
+       }
+
+      if (0 || 
+#ifdef HAVE_MENUBARS
+         menubar_show_keybindings
+#endif
+         )
+       {
+         /* Need to get keybindings */
+         if (!NILP (keys))
+           {
+             /* User-specified string to generate key bindings with */
+             CHECK_STRING (keys);
+
+             keys = Fsubstitute_command_keys (keys);
+           }
+         else if (SYMBOLP (callback))
+           {
+             char buf[1024];
+
+             /* #### Warning, dependency here on current_buffer and point */
+             where_is_to_char (callback, buf);
+
+             keys = build_string (buf);
+           }
+       }
+
+      /* Now we get down to the dirty business of creating the widgets */
+      if (NILP (style) || EQ (style, Qtext) || EQ (style, Qbutton))
+       {
+         /* A normal menu item */
+         widget = gtk_menu_item_new ();
+       }
+      else if (EQ (style, Qtoggle) || EQ (style, Qradio))
+       {
+         /* They are radio or toggle buttons.
+
+            XEmacs' menu descriptions are fairly lame in that they do
+            not have the idea of a 'group' of radio buttons.  They
+            are exactly like toggle buttons except that they get
+            drawn differently.
+
+            GTK rips us a new one again.  If you have a radio button
+            in a group by itself, it always draws it as highlighted.
+            So we dummy up and create a second radio button that does
+            not get added to the menu, but gets invisibly set/unset
+            when the other gets unset/set.  *sigh*
+
+         */
+         if (EQ (style, Qradio))
+           {
+             GtkWidget *dummy_sibling = NULL;
+             GSList *group = NULL;
+
+             dummy_sibling = gtk_radio_menu_item_new (group);
+             group = gtk_radio_menu_item_group (GTK_RADIO_MENU_ITEM (dummy_sibling));
+             widget = gtk_radio_menu_item_new (group);
+
+             /* We need to notice when the 'real' one gets destroyed
+                 so we can clean up the dummy as well. */
+             gtk_object_weakref (GTK_OBJECT (widget),
+                                 (GtkDestroyNotify) gtk_widget_destroy,
+                                 dummy_sibling);
+           }
+         else
+           {
+             widget = gtk_check_menu_item_new ();
+           }
+
+         /* What horrible defaults you have GTK dear!  The default
+           for a toggle menu item is to not show the toggle unless it
+           is turned on or actively highlighted.  How absolutely
+           hideous. */
+         gtk_check_menu_item_set_show_toggle (GTK_CHECK_MENU_ITEM (widget), TRUE);
+         gtk_check_menu_item_set_active (GTK_CHECK_MENU_ITEM (widget),
+                                         NILP (selected_p) ? FALSE : TRUE);
+       }
+      else
+       {
+         signal_simple_error_2 ("unknown style", style, descr);
+       }
+
+      gtk_widget_set_sensitive (widget, ! NILP (active_p));
+
+      gtk_signal_connect (GTK_OBJECT (widget), "activate-item",
+                         GTK_SIGNAL_FUNC (__generic_button_callback),
+                         LISP_TO_VOID (callback));
+
+      gtk_signal_connect (GTK_OBJECT (widget), "activate",
+                         GTK_SIGNAL_FUNC (__generic_button_callback),
+                         LISP_TO_VOID (callback));
+
+      /* We cheat here... GtkAccelLabel usually builds its
+        `accel_string' from the widget it is attached to, but we do
+        not want to go thru the overhead of converting our nice
+        string back into the modifier + key format that requires,
+        just so that they can convert it back into a (possibly
+        different/wrong) string
+
+        We set the label string manually, and things should 'just
+        work'
+
+        In an ideal world we would just subclass GtkLabel ourselves,
+        but I have known for a very long time that this is not an
+        ideal world.
+
+        #### Should do menu shortcuts `correctly' one of these days.
+      */
+      
+      if (main_label)
+       {
+         GtkAccelLabel *l = GTK_ACCEL_LABEL (main_label);
+
+         gtk_container_add (GTK_CONTAINER (widget), main_label);
+
+         gtk_accel_label_set_accel_widget (l, NULL);
+         gtk_misc_set_alignment (GTK_MISC (l), 0.0, 0.5);
+
+         if (STRINGP (keys) && XSTRING_LENGTH (keys))
+           {
+             l->accel_string = g_strdup (XSTRING_DATA (keys));
+           }
+       }
+
+      return (widget);
+    }
+  else
+    {
+      return (NULL);
+      /* abort (); ???? */
+    }
+}
+
+static GtkWidget *menu_descriptor_to_widget (Lisp_Object descr)
+{
+  int count = specpdl_depth ();
+  GtkWidget *rval = NULL;
+
+  record_unwind_protect (restore_gc_inhibit, make_int (gc_currently_forbidden));
+
+  gc_currently_forbidden = 1;
+
+  /* Cannot GC from here on out... */
+  rval = menu_descriptor_to_widget_1 (descr);
+  unbind_to (count, Qnil);
+  return (rval);
+  
+}
+
+static gboolean
+menu_can_reuse_widget (GtkWidget *child, const char *label)
+{
+  /* Everything up at the top level was done using
+  ** gtk_menu_item_new_with_label(), but we still double check to make
+  ** sure we don't seriously foobar ourselves.
+  */
+  char *temp_label = NULL;
+  gpointer possible_child = g_list_nth_data (gtk_container_children (GTK_CONTAINER (child)), 0);
+
+  if (possible_child && GTK_IS_LABEL (possible_child))
+    {
+      if (!temp_label) temp_label = remove_underscores (label);
+      if (!strcmp (GTK_LABEL (possible_child)->label, temp_label))
+       {
+         free (temp_label);
+         return (TRUE);
+       }
+    }
+  if (temp_label) free (temp_label);
+  return (FALSE);
+}
+
+/* Converts a menubar description into a GtkMenuBar... a menubar is a
+   list of menus or buttons 
+*/
+static void
+menu_create_menubar (struct frame *f, Lisp_Object descr)
+{
+  gboolean right_justify = FALSE;
+  Lisp_Object tail = Qnil;
+  Lisp_Object value = descr;
+  Lisp_Object item_descr = Qnil;
+  GtkWidget *menubar = FRAME_GTK_MENUBAR_WIDGET (f);
+  GUI_ID id = (GUI_ID) gtk_object_get_data (GTK_OBJECT (menubar), XEMACS_MENU_GUIID_TAG);
+  guint menu_position = 0;
+
+  /* Remove any existing protection for old menu items */
+  ungcpro_popup_callbacks (id);
+
+  /* GCPRO the whole damn thing */
+  gcpro_popup_callbacks (id, descr);
+
+  EXTERNAL_LIST_LOOP (tail, value)
+    {
+      gpointer current_child = g_list_nth_data (GTK_MENU_SHELL (menubar)->children, menu_position);
+
+      item_descr = XCAR (tail);
+
+      if (NILP (item_descr))
+       {
+         /* Need to start right-justifying menus */
+         right_justify = TRUE;
+         menu_position--;
+       }
+      else if (VECTORP (item_descr))
+       {
+         /* It is a button description */
+         GtkWidget *item;
+
+         item = menu_descriptor_to_widget (item_descr);
+         gtk_widget_set_name (item, "XEmacsMenuButton");
+
+         if (!item)
+           {
+             item = gtk_menu_item_new_with_label ("ITEM CREATION ERROR");
+           }
+
+         gtk_widget_show_all (item);
+         if (current_child) gtk_widget_destroy (GTK_WIDGET (current_child));
+         gtk_menu_bar_insert (GTK_MENU_BAR (menubar), item, menu_position);
+       }
+      else if (LISTP (item_descr))
+       {
+         /* Need to actually convert it into a menu and slap it in */
+         GtkWidget *widget;
+         gboolean reused_p = FALSE;
+
+         /* We may be able to reuse the widget, let's at least check. */
+         if (current_child && menu_can_reuse_widget (GTK_WIDGET (current_child),
+                                                     XSTRING_DATA (XCAR (item_descr))))
+           {
+             widget = menu_convert (item_descr, GTK_WIDGET (current_child));
+             reused_p = TRUE;
+           }
+         else
+           {
+             widget = menu_convert (item_descr, NULL);
+             if (current_child) gtk_widget_destroy (GTK_WIDGET (current_child));
+             gtk_menu_bar_insert (GTK_MENU_BAR (menubar), widget, menu_position);
+           }
+
+         if (widget)
+           {
+             if (right_justify) gtk_menu_item_right_justify (GTK_MENU_ITEM (widget));
+           }
+         else
+           {
+             widget = gtk_menu_item_new_with_label ("ERROR");
+             /* abort() */
+           }
+         gtk_widget_show_all (widget);
+       }
+      else if (STRINGP (item_descr))
+       {
+         /* Do I really want to be this careful?  Anything else in a
+             menubar description is illegal */
+       }
+      menu_position++;
+    }
+
+  /* Need to delete any menu items that were past the bounds of the new one */
+  {
+    GList *l = NULL;
+
+    while ((l = g_list_nth (GTK_MENU_SHELL (menubar)->children, menu_position)))
+      {
+       gpointer data = l->data;
+       g_list_remove_link (GTK_MENU_SHELL (menubar)->children, l);
+
+       if (data)
+         {
+           gtk_widget_destroy (GTK_WIDGET (data));
+         }
+      }
+  }
+}
+
+\f
+/* Deal with getting/setting the menubar */
+#ifndef GNOME_IS_APP
+#define GNOME_IS_APP(x) 0
+#define gnome_app_set_menus(x,y)
+#endif
+
+static gboolean
+run_menubar_hook (GtkWidget *widget, GdkEventButton *event, gpointer user_data)
+{
+  if (!GTK_MENU_SHELL(widget)->active)
+    {
+      run_hook (Qactivate_menubar_hook);
+    }
+  return(FALSE);
+}
+
+static void
+create_menubar_widget (struct frame *f)
+{
+  GUI_ID id = new_gui_id ();
+  GtkWidget *handlebox = NULL;
+  GtkWidget *menubar = gtk_xemacs_menubar_new (f);
+
+  if (GNOME_IS_APP (FRAME_GTK_SHELL_WIDGET (f)))
+    {
+      gnome_app_set_menus (GNOME_APP (FRAME_GTK_SHELL_WIDGET (f)), GTK_MENU_BAR (menubar));
+    }
+  else if (dockable_menubar)
+    {
+      handlebox = gtk_handle_box_new ();
+      gtk_handle_box_set_handle_position (GTK_HANDLE_BOX (handlebox), GTK_POS_LEFT);
+      gtk_container_add (GTK_CONTAINER (handlebox), menubar);
+      gtk_box_pack_start (GTK_BOX (FRAME_GTK_CONTAINER_WIDGET (f)), handlebox, FALSE, FALSE, 0);
+    }
+  else
+    {
+      gtk_box_pack_start (GTK_BOX (FRAME_GTK_CONTAINER_WIDGET (f)), menubar, FALSE, FALSE, 0);
+    }
+
+  gtk_signal_connect (GTK_OBJECT (menubar), "button-press-event",
+                     GTK_SIGNAL_FUNC (run_menubar_hook), NULL);
+
+  FRAME_GTK_MENUBAR_WIDGET (f) = menubar;
+  gtk_object_set_data (GTK_OBJECT (menubar), XEMACS_MENU_GUIID_TAG, (gpointer) id);
+  gtk_object_weakref (GTK_OBJECT (menubar), __remove_gcpro_by_id, (gpointer) id);
+}
+
+static int
+set_frame_menubar (struct frame *f, int first_time_p)
+{
+  Lisp_Object menubar;
+  int menubar_visible;
+  /* As for the toolbar, the minibuffer does not have its own menubar. */
+  struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f));
+
+  if (! FRAME_GTK_P (f))
+    return 0;
+
+  /***** first compute the contents of the menubar *****/
+
+  if (! first_time_p)
+    {
+      /* evaluate `current-menubar' in the buffer of the selected window
+        of the frame in question. */
+      menubar = symbol_value_in_buffer (Qcurrent_menubar, w->buffer);
+    }
+  else
+    {
+      /* That's a little tricky the first time since the frame isn't
+        fully initialized yet. */
+      menubar = Fsymbol_value (Qcurrent_menubar);
+    }
+
+  if (NILP (menubar))
+    {
+      menubar = Vblank_menubar;
+      menubar_visible = 0;
+    }
+  else
+    {
+      menubar_visible = !NILP (w->menubar_visible_p);
+    }
+
+  if (!FRAME_GTK_MENUBAR_WIDGET (f))
+    {
+      create_menubar_widget (f);
+    }
+
+  /* Populate the menubar, but nothing is shown yet */
+  {
+    Lisp_Object old_buffer;
+    int count = specpdl_depth ();
+
+    old_buffer = Fcurrent_buffer ();
+    record_unwind_protect (Fset_buffer, old_buffer);
+    Fset_buffer (XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer);
+
+    menu_create_menubar (f, menubar);
+
+    Fset_buffer (old_buffer);
+    unbind_to (count, Qnil);
+  }
+
+  FRAME_MENUBAR_DATA (f) = Fcons (XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer, Qt);
+
+  return (menubar_visible);
+}
+
+/* Called from gtk_create_widgets() to create the inital menubar of a frame
+   before it is mapped, so that the window is mapped with the menubar already
+   there instead of us tacking it on later and thrashing the window after it
+   is visible. */
+int
+gtk_initialize_frame_menubar (struct frame *f)
+{
+  create_menubar_widget  (f);
+  return set_frame_menubar (f, 1);
+}
+
+\f
+static void
+gtk_update_frame_menubar_internal (struct frame *f)
+{
+  /* We assume the menubar contents has changed if the global flag is set,
+     or if the current buffer has changed, or if the menubar has never
+     been updated before.
+   */
+  int menubar_contents_changed =
+    (f->menubar_changed
+     || NILP (FRAME_MENUBAR_DATA (f))
+     || (!EQ (XFRAME_MENUBAR_DATA_LASTBUFF (f),
+             XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer)));
+
+  gboolean menubar_was_visible = GTK_WIDGET_VISIBLE (FRAME_GTK_MENUBAR_WIDGET (f));
+  gboolean menubar_will_be_visible = menubar_was_visible;
+  gboolean menubar_visibility_changed;
+
+  if (menubar_contents_changed)
+    {
+      menubar_will_be_visible = set_frame_menubar (f, 0);
+    }
+
+  menubar_visibility_changed = menubar_was_visible != menubar_will_be_visible;
+
+  if (!menubar_visibility_changed)
+    {
+      return;
+    }
+
+  /* We hide and show the menubar's parent (which is actually the
+     GtkHandleBox)... this is to simplify the code that destroys old
+     menu items, etc.  There is no easy way to get the child out of a
+     handle box, and I didn't want to add yet another stupid widget
+     slot to struct gtk_frame. */
+  if (menubar_will_be_visible)
+    {
+      gtk_widget_show_all (FRAME_GTK_MENUBAR_WIDGET (f)->parent);
+    }
+  else
+    {
+      gtk_widget_hide_all (FRAME_GTK_MENUBAR_WIDGET (f)->parent);
+    }
+
+  MARK_FRAME_SIZE_SLIPPED (f);
+}
+
+static void
+gtk_update_frame_menubars (struct frame *f)
+{
+  GtkWidget *menubar = NULL;
+
+  assert (FRAME_GTK_P (f));
+
+  menubar = FRAME_GTK_MENUBAR_WIDGET (f);
+
+  if ((GTK_MENU_SHELL (menubar)->active) ||
+      (GTK_MENU_SHELL (menubar)->have_grab) ||
+      (GTK_MENU_SHELL (menubar)->have_xgrab))
+    {
+      return;
+    }
+ 
+  gtk_update_frame_menubar_internal (f);
+}
+
+static void
+gtk_free_frame_menubars (struct frame *f)
+{
+  GtkWidget *menubar_widget;
+
+  assert (FRAME_GTK_P (f));
+
+  menubar_widget = FRAME_GTK_MENUBAR_WIDGET (f);
+  if (menubar_widget)
+    {
+      gtk_widget_destroy (menubar_widget);
+    }
+}
+
+static void popdown_menu_cb (GtkMenuShell *menu, gpointer user_data)
+{
+  popup_up_p--;
+}
+
+static void
+gtk_popup_menu (Lisp_Object menu_desc, Lisp_Object event)
+{
+  struct Lisp_Event *eev = NULL;
+  GtkWidget *widget = menu_descriptor_to_widget (menu_desc);
+  GtkWidget *menu = GTK_MENU_ITEM (widget)->submenu;
+  gpointer id = gtk_object_get_data (GTK_OBJECT (widget), XEMACS_MENU_GUIID_TAG);
+
+  gtk_widget_set_name (widget, "XEmacsPopupMenu");
+
+  __activate_menu (GTK_MENU_ITEM (widget), id);
+
+  if (!NILP (event))
+    {
+      CHECK_LIVE_EVENT (event);
+      eev = XEVENT (event);
+
+      if ((eev->event_type != button_press_event) &&
+         (eev->event_type != button_release_event))
+       wrong_type_argument (Qmouse_event_p, event);
+    }
+  else if (!NILP (Vthis_command_keys))
+    {
+      /* If an event wasn't passed, use the last event of the event
+         sequence currently being executed, if that event is a mouse
+         event. */
+      eev = XEVENT (Vthis_command_keys);
+      if ((eev->event_type != button_press_event) &&
+         (eev->event_type != button_release_event))
+       eev = NULL;
+    }
+
+  gtk_widget_show (menu);
+
+  popup_up_p++;
+  gtk_signal_connect (GTK_OBJECT (menu), "deactivate",
+                     GTK_SIGNAL_FUNC (popdown_menu_cb), NULL);
+                     
+  gtk_menu_popup (GTK_MENU (menu), NULL, NULL, NULL, NULL,
+                 eev ? eev->event.button.button : 0,
+                 eev ? eev->timestamp : GDK_CURRENT_TIME);
+}
+
+DEFUN ("gtk-build-xemacs-menu", Fgtk_build_xemacs_menu, 1, 1, 0, /*
+Returns a GTK menu item from MENU, a standard XEmacs menu description.
+See the definition of `popup-menu' for more information on the format of MENU.
+*/
+       (menu))
+{
+  GtkWidget *w = menu_descriptor_to_widget (menu);
+
+  return (w ? build_gtk_object (GTK_OBJECT (w)) : Qnil);
+}
+
+\f
+void
+syms_of_menubar_gtk (void)
+{
+  DEFSUBR (Fgtk_build_xemacs_menu);
+}
+
+void
+console_type_create_menubar_gtk (void)
+{
+  CONSOLE_HAS_METHOD (gtk, update_frame_menubars);
+  CONSOLE_HAS_METHOD (gtk, free_frame_menubars);
+  CONSOLE_HAS_METHOD (gtk, popup_menu);
+}
+
+void reinit_vars_of_menubar_gtk (void)
+{
+  dockable_menubar = 1;
+#ifdef TEAR_OFF_MENUS
+  tear_off_menus = 1;
+#endif
+}
+
+void
+vars_of_menubar_gtk (void)
+{
+  Fprovide (intern ("gtk-menubars"));
+  DEFVAR_BOOL ("menubar-dockable-p", &dockable_menubar /*
+If non-nil, the frame menubar can be detached into its own top-level window.
+*/ );
+#ifdef TEAR_OFF_MENUS
+  DEFVAR_BOOL ("menubar-tearable-p", &tear_off_menus /*
+If non-nil, menus can be torn off into their own top-level windows.
+*/ );
+#endif
+  reinit_vars_of_menubar_gtk ();
+}

diff --git a/src/native-gtk-toolbar.c b/src/native-gtk-toolbar.c
new file mode 100644 (file)
index 0000000..8757108
--- /dev/null
+++ b/src/native-gtk-toolbar.c
@@ -0,0 +1,243 @@
+/* toolbar implementation -- GTK interface.
+   Copyright (C) 2000 Aaron Lehmann
+
+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, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with: Not in FSF. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "console-gtk.h"
+#include "glyphs-gtk.h"
+#include "objects-gtk.h"
+
+#include "faces.h"
+#include "frame.h"
+#include "toolbar.h"
+#include "window.h"
+
+#define SET_TOOLBAR_WAS_VISIBLE_FLAG(frame, pos, flag)                 \
+  do {                                                                 \
+    switch (pos)                                                       \
+      {                                                                        \
+      case TOP_TOOLBAR:                                                        \
+       (frame)->top_toolbar_was_visible = flag;                        \
+       break;                                                          \
+      case BOTTOM_TOOLBAR:                                             \
+       (frame)->bottom_toolbar_was_visible = flag;                     \
+       break;                                                          \
+      case LEFT_TOOLBAR:                                               \
+       (frame)->left_toolbar_was_visible = flag;                       \
+       break;                                                          \
+      case RIGHT_TOOLBAR:                                              \
+       (frame)->right_toolbar_was_visible = flag;                      \
+       break;                                                          \
+      default:                                                         \
+       abort ();                                                       \
+      }                                                                        \
+  } while (0)
+
+static void
+gtk_clear_toolbar (struct frame *f, enum toolbar_pos pos);
+
+static void
+gtk_toolbar_callback (GtkWidget *w, gpointer user_data)
+{
+  struct toolbar_button *tb = (struct toolbar_button *) user_data;
+
+  call0 (tb->callback);
+}
+
+
+static void
+gtk_output_toolbar (struct frame *f, enum toolbar_pos pos)
+{
+  GtkWidget *toolbar;
+  Lisp_Object button, window, glyph, instance;
+  unsigned int checksum = 0;
+  struct window *w;
+  int x, y, bar_width, bar_height, vert;
+  int cur_x, cur_y;
+
+  window = FRAME_LAST_NONMINIBUF_WINDOW (f);
+  w = XWINDOW (window);
+
+  get_toolbar_coords (f, pos, &x, &y, &bar_width, &bar_height, &vert, 0);
+       
+  /* Get the toolbar and delete the old widgets in it */
+  button = FRAME_TOOLBAR_BUTTONS (f, pos);
+       
+  /* First loop over all of the buttons to determine how many there
+     are. This loop will also make sure that all instances are
+     instantiated so when we actually output them they will come up
+     immediately. */
+  while (!NILP (button))
+    {
+      struct toolbar_button *tb = XTOOLBAR_BUTTON (button);
+      checksum = HASH4 (checksum, 
+                       internal_hash (get_toolbar_button_glyph(w, tb), 0),
+                       internal_hash (tb->callback, 0),
+                       0 /* width */);
+      button = tb->next;
+    }
+
+  /* Only do updates if the toolbar has changed, or this is the first
+     time we have drawn it in this position
+  */
+  if (FRAME_GTK_TOOLBAR_WIDGET (f)[pos] &&
+      FRAME_GTK_TOOLBAR_CHECKSUM (f, pos) == checksum)
+    {
+      return;
+    }
+
+  /* Loop through buttons and add them to our toolbar.
+     This code ignores the button dimensions as we let GTK handle that :)
+     Attach the toolbar_button struct to the toolbar button so we know what
+     function to use as a callback. */
+
+  {
+    gtk_clear_toolbar (f, pos);
+    FRAME_GTK_TOOLBAR_WIDGET (f)[pos] = toolbar =
+      gtk_toolbar_new (((pos == TOP_TOOLBAR) || (pos == BOTTOM_TOOLBAR)) ?
+                      GTK_ORIENTATION_HORIZONTAL : GTK_ORIENTATION_VERTICAL,
+                      GTK_TOOLBAR_BOTH);
+  }
+
+  if (NILP (w->toolbar_buttons_captioned_p))
+    gtk_toolbar_set_style (toolbar, GTK_TOOLBAR_ICONS);
+  else
+    gtk_toolbar_set_style (toolbar, GTK_TOOLBAR_BOTH);
+
+  FRAME_GTK_TOOLBAR_CHECKSUM(f, pos) = checksum;
+  button = FRAME_TOOLBAR_BUTTONS (f, pos);
+
+  cur_x = 0;
+  cur_y = 0;
+
+  while (!NILP (button))
+    {
+      struct toolbar_button *tb = XTOOLBAR_BUTTON (button);
+
+      if (tb->blank)
+       {
+         /* It is a blank space... we do not pay attention to the
+             size, because the GTK toolbar does not allow us to
+             specify different spacings.  *sigh*
+         */
+         gtk_toolbar_append_space (GTK_TOOLBAR (toolbar));
+       }
+      else
+       {
+         /* It actually has a glyph associated with it!  What WILL
+             they think of next?
+         */
+         glyph = tb->up_glyph;
+
+         /* #### It is currently possible for users to trash us by directly
+            changing the toolbar glyphs.  Avoid crashing in that case. */
+         if (GLYPHP (glyph))
+           instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
+         else
+           instance = Qnil;
+         
+         if (IMAGE_INSTANCEP(instance))
+           {
+             GtkWidget *pixmapwid;
+             GdkPixmap *pixmap;
+             GdkBitmap *mask;
+             char *tooltip = NULL;
+
+             if (STRINGP (tb->help_string))
+               tooltip = XSTRING_DATA (tb->help_string);
+             
+             pixmap = XIMAGE_INSTANCE_GTK_PIXMAP(instance);
+             mask = XIMAGE_INSTANCE_GTK_MASK(instance);
+             pixmapwid = gtk_pixmap_new (pixmap, mask);
+
+             gtk_widget_set_usize (pixmapwid, tb->width, tb->height);
+             
+             gtk_toolbar_append_item (GTK_TOOLBAR(toolbar), NULL, tooltip, NULL,
+                                      pixmapwid, gtk_toolbar_callback, (gpointer) tb);
+           }
+       }
+      cur_x += vert ? 0 : tb->width;
+      cur_y += vert ? tb->height : 0;
+      /* Who's idea was it to use a linked list for toolbar buttons? */
+      button = tb->next;
+    }
+
+  SET_TOOLBAR_WAS_VISIBLE_FLAG (f, pos, 1);
+
+  x -= vert ? 3 : 2;
+  y -= vert ? 2 : 3;
+  
+  gtk_fixed_put (GTK_FIXED (FRAME_GTK_TEXT_WIDGET (f)), FRAME_GTK_TOOLBAR_WIDGET (f)[pos],x, y);
+  gtk_widget_show_all (FRAME_GTK_TOOLBAR_WIDGET (f)[pos]);
+}
+
+static void
+gtk_clear_toolbar (struct frame *f, enum toolbar_pos pos)
+{
+  FRAME_GTK_TOOLBAR_CHECKSUM (f, pos) = 0;
+  SET_TOOLBAR_WAS_VISIBLE_FLAG (f, pos, 0);
+  if (FRAME_GTK_TOOLBAR_WIDGET(f)[pos])
+    gtk_widget_destroy (FRAME_GTK_TOOLBAR_WIDGET(f)[pos]);
+}
+
+static void
+gtk_output_frame_toolbars (struct frame *f)
+{
+  if (FRAME_REAL_TOP_TOOLBAR_VISIBLE (f))
+    gtk_output_toolbar (f, TOP_TOOLBAR);
+  else if (f->top_toolbar_was_visible)
+    gtk_clear_toolbar (f, TOP_TOOLBAR);
+
+  if (FRAME_REAL_BOTTOM_TOOLBAR_VISIBLE (f))
+    gtk_output_toolbar (f, BOTTOM_TOOLBAR);
+  else if (f->bottom_toolbar_was_visible)
+    gtk_clear_toolbar (f, LEFT_TOOLBAR);
+
+  if (FRAME_REAL_LEFT_TOOLBAR_VISIBLE (f))
+    gtk_output_toolbar (f, LEFT_TOOLBAR);
+  else if (f->left_toolbar_was_visible)
+    gtk_clear_toolbar (f, LEFT_TOOLBAR);
+
+  if (FRAME_REAL_RIGHT_TOOLBAR_VISIBLE (f))
+    gtk_output_toolbar (f, RIGHT_TOOLBAR);
+  else if (f->right_toolbar_was_visible)
+    gtk_clear_toolbar (f, RIGHT_TOOLBAR);
+}
+
+static void
+gtk_initialize_frame_toolbars (struct frame *f)
+{
+  stderr_out ("We should draw toolbars\n");
+}
+
+\f
+/************************************************************************/
+/*                            initialization                            */
+/************************************************************************/
+
+void
+console_type_create_toolbar_gtk (void)
+{
+  CONSOLE_HAS_METHOD (gtk, output_frame_toolbars);
+  CONSOLE_HAS_METHOD (gtk, initialize_frame_toolbars);
+}

diff --git a/src/objects-gtk.c b/src/objects-gtk.c
new file mode 100644 (file)
index 0000000..72fde7c
--- /dev/null
+++ b/src/objects-gtk.c
@@ -0,0 +1,603 @@
+/* X-specific Lisp objects.
+   Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+   Copyright (C) 1995 Board of Trustees, University of Illinois.
+   Copyright (C) 1995 Tinker Systems.
+   Copyright (C) 1995, 1996 Ben Wing.
+   Copyright (C) 1995 Sun Microsystems, Inc.
+
+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, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with: Not in FSF. */
+
+/* Authors: Jamie Zawinski, Chuck Thompson, Ben Wing */
+/* Gtk version by William Perry */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "console-gtk.h"
+#include "objects-gtk.h"
+
+#include "buffer.h"
+#include "device.h"
+#include "insdel.h"
+
+/* sigh */
+#include <gdk/gdkx.h>
+
+\f
+/************************************************************************/
+/*                          color instances                             */
+/************************************************************************/
+
+/* Replacement for XAllocColor() that tries to return the nearest
+   available color if the colormap is full.  Original was from FSFmacs,
+   but rewritten by Jareth Hein <jareth@camelot-soft.com> 97/11/25
+   Modified by Lee Kindness <lkindness@csl.co.uk> 31/08/99 to handle previous
+   total failure which was due to a read/write colorcell being the nearest
+   match - tries the next nearest...
+
+   Gdk takes care of all this behind the scenes, so we don't need to
+   worry about it.
+
+   Return value is 1 for normal success, 2 for nearest color success,
+   3 for Non-deallocable sucess. */
+int
+allocate_nearest_color (GdkColormap *colormap, GdkVisual *visual,
+                       GdkColor *color_def)
+{
+  int rc;
+
+  rc = gdk_colormap_alloc_color (colormap, color_def, FALSE, TRUE);
+
+  if (rc == TRUE)
+      return (1);
+
+  return (0);
+}
+
+int
+gtk_parse_nearest_color (struct device *d, GdkColor *color, Bufbyte *name,
+                        Bytecount len, Error_behavior errb)
+{
+  GdkColormap *cmap;
+  GdkVisual *visual;
+  int result;
+
+  cmap = DEVICE_GTK_COLORMAP(d);
+  visual = DEVICE_GTK_VISUAL (d);
+
+  xzero (*color);
+  {
+    const Extbyte *extname;
+    Extcount extnamelen;
+
+    TO_EXTERNAL_FORMAT (DATA, (name, len), ALLOCA, (extname, extnamelen), Qbinary);
+
+    result = gdk_color_parse (extname, color);
+  }
+  
+  if (result == FALSE)
+    {
+      maybe_signal_simple_error ("unrecognized color", make_string (name, len),
+                                Qcolor, errb);
+      return 0;
+    }
+  result = allocate_nearest_color (cmap, visual, color);
+  if (!result)
+    {
+      maybe_signal_simple_error ("couldn't allocate color",
+                                make_string (name, len), Qcolor, errb);
+      return 0;
+    }
+
+  return result;
+}
+
+static int
+gtk_initialize_color_instance (struct Lisp_Color_Instance *c, Lisp_Object name,
+                              Lisp_Object device, Error_behavior errb)
+{
+  GdkColor color;
+  int result;
+
+  result = gtk_parse_nearest_color (XDEVICE (device), &color,
+                                   XSTRING_DATA   (name),
+                                   XSTRING_LENGTH (name),
+                                   errb);
+
+  if (!result)
+    return 0;
+
+  /* Don't allocate the data until we're sure that we will succeed,
+     or the finalize method may get fucked. */
+  c->data = xnew (struct gtk_color_instance_data);
+  if (result == 3)
+    COLOR_INSTANCE_GTK_DEALLOC (c) = 0;
+  else
+    COLOR_INSTANCE_GTK_DEALLOC (c) = 1;
+  COLOR_INSTANCE_GTK_COLOR (c) = gdk_color_copy (&color);
+  return 1;
+}
+
+static void
+gtk_print_color_instance (struct Lisp_Color_Instance *c,
+                         Lisp_Object printcharfun,
+                         int escapeflag)
+{
+  char buf[100];
+  GdkColor *color = COLOR_INSTANCE_GTK_COLOR (c);
+  sprintf (buf, " %ld=(%X,%X,%X)",
+          color->pixel, color->red, color->green, color->blue);
+  write_c_string (buf, printcharfun);
+}
+
+static void
+gtk_finalize_color_instance (struct Lisp_Color_Instance *c)
+{
+  if (c->data)
+    {
+      if (DEVICE_LIVE_P (XDEVICE (c->device)))
+       {
+         if (COLOR_INSTANCE_GTK_DEALLOC (c))
+           {
+               gdk_colormap_free_colors (DEVICE_GTK_COLORMAP (XDEVICE (c->device)),
+                                         COLOR_INSTANCE_GTK_COLOR (c), 1);
+           }
+           gdk_color_free (COLOR_INSTANCE_GTK_COLOR (c));
+       }
+      xfree (c->data);
+      c->data = 0;
+    }
+}
+
+/* Color instances are equal if they resolve to the same color on the
+   screen (have the same RGB values).  I imagine that
+   "same RGB values" == "same cell in the colormap."  Arguably we should
+   be comparing their names or pixel values instead. */
+
+static int
+gtk_color_instance_equal (struct Lisp_Color_Instance *c1,
+                         struct Lisp_Color_Instance *c2,
+                         int depth)
+{
+    return (gdk_color_equal (COLOR_INSTANCE_GTK_COLOR (c1),
+                            COLOR_INSTANCE_GTK_COLOR (c2)));
+}
+
+static unsigned long
+gtk_color_instance_hash (struct Lisp_Color_Instance *c, int depth)
+{
+    return (gdk_color_hash (COLOR_INSTANCE_GTK_COLOR (c), NULL));
+}
+
+static Lisp_Object
+gtk_color_instance_rgb_components (struct Lisp_Color_Instance *c)
+{
+  GdkColor *color = COLOR_INSTANCE_GTK_COLOR (c);
+  return (list3 (make_int (color->red),
+                make_int (color->green),
+                make_int (color->blue)));
+}
+
+static int
+gtk_valid_color_name_p (struct device *d, Lisp_Object color)
+{
+  GdkColor c;
+  const char *extname;
+
+  TO_EXTERNAL_FORMAT (LISP_STRING, color, C_STRING_ALLOCA, extname, Qctext);
+
+  if (gdk_color_parse (extname, &c) != TRUE)
+      return(0);
+  return (1);
+}
+
+\f
+/************************************************************************/
+/*                           font instances                             */
+/************************************************************************/
+
+static int
+gtk_initialize_font_instance (struct Lisp_Font_Instance *f, Lisp_Object name,
+                             Lisp_Object device, Error_behavior errb)
+{
+  GdkFont *gf;
+  XFontStruct *xf;
+  const char *extname;
+
+  TO_EXTERNAL_FORMAT (LISP_STRING, f->name, C_STRING_ALLOCA, extname, Qctext);
+
+  gf = gdk_font_load (extname);
+
+  if (!gf)
+    {
+      maybe_signal_simple_error ("couldn't load font", f->name,
+                                Qfont, errb);
+      return 0;
+    }
+
+  xf = GDK_FONT_XFONT (gf);
+
+  /* Don't allocate the data until we're sure that we will succeed,
+     or the finalize method may get fucked. */
+  f->data = xnew (struct gtk_font_instance_data);
+  FONT_INSTANCE_GTK_TRUENAME (f) = Qnil;
+  FONT_INSTANCE_GTK_FONT (f) = gf;
+  f->ascent = gf->ascent;
+  f->descent = gf->descent;
+  f->height = gf->ascent + gf->descent;
+
+  /* Now lets figure out the width of the font */
+  {
+    /* following change suggested by Ted Phelps <phelps@dstc.edu.au> */
+    unsigned int def_char = 'n'; /*xf->default_char;*/
+    unsigned int byte1, byte2;
+
+  once_more:
+    byte1 = def_char >> 8;
+    byte2 = def_char & 0xFF;
+
+    if (xf->per_char)
+      {
+       /* Old versions of the R5 font server have garbage (>63k) as
+          def_char. 'n' might not be a valid character. */
+       if (byte1 < xf->min_byte1         ||
+           byte1 > xf->max_byte1         ||
+           byte2 < xf->min_char_or_byte2 ||
+           byte2 > xf->max_char_or_byte2)
+         f->width = 0;
+       else
+         f->width = xf->per_char[(byte1 - xf->min_byte1) *
+                                 (xf->max_char_or_byte2 -
+                                  xf->min_char_or_byte2 + 1) +
+                                 (byte2 - xf->min_char_or_byte2)].width;
+      }
+    else
+      f->width = xf->max_bounds.width;
+
+    /* Some fonts have a default char whose width is 0.  This is no good.
+       If that's the case, first try 'n' as the default char, and if n has
+       0 width too (unlikely) then just use the max width. */
+    if (f->width == 0)
+      {
+       if (def_char == xf->default_char)
+         f->width = xf->max_bounds.width;
+       else
+         {
+           def_char = xf->default_char;
+           goto once_more;
+         }
+      }
+  }
+
+  /* If all characters don't exist then there could potentially be
+     0-width characters lurking out there.  Not setting this flag
+     trips an optimization that would make them appear to have width
+     to redisplay.  This is bad.  So we set it if not all characters
+     have the same width or if not all characters are defined.
+     */
+  /* #### This sucks.  There is a measurable performance increase
+     when using proportional width fonts if this flag is not set.
+     Unfortunately so many of the fucking X fonts are not fully
+     defined that we could almost just get rid of this damn flag and
+     make it an assertion. */
+  f->proportional_p = (xf->min_bounds.width != xf->max_bounds.width ||
+                      (/* x_handle_non_fully_specified_fonts */ 0 &&
+                       !xf->all_chars_exist));
+#if 0
+  f->width = gdk_char_width (gf, 'n');
+  f->proportional_p = (gdk_char_width (gf, '|') != gdk_char_width (gf, 'W')) ? 1 : 0;
+#endif
+  return 1;
+}
+
+static void
+gtk_mark_font_instance (struct Lisp_Font_Instance *f)
+{
+  mark_object (FONT_INSTANCE_GTK_TRUENAME (f));
+}
+
+static void
+gtk_print_font_instance (struct Lisp_Font_Instance *f,
+                        Lisp_Object printcharfun,
+                        int escapeflag)
+{
+  char buf[200];
+  sprintf (buf, " 0x%lx", (unsigned long) gdk_font_id (FONT_INSTANCE_GTK_FONT (f)));
+  write_c_string (buf, printcharfun);
+}
+
+static void
+gtk_finalize_font_instance (struct Lisp_Font_Instance *f)
+{
+  if (f->data)
+    {
+      if (DEVICE_LIVE_P (XDEVICE (f->device)))
+       {
+           gdk_font_unref (FONT_INSTANCE_GTK_FONT (f));
+       }
+      xfree (f->data);
+      f->data = 0;
+    }
+}
+
+/* Forward declarations for X specific functions at the end of the file */
+Lisp_Object __get_gtk_font_truename (GdkFont *gdk_font, int expandp);
+static Lisp_Object __gtk_list_fonts_internal (const char *pattern);
+
+static Lisp_Object
+gtk_font_instance_truename (struct Lisp_Font_Instance *f, Error_behavior errb)
+{
+  if (NILP (FONT_INSTANCE_GTK_TRUENAME (f)))
+    {
+      FONT_INSTANCE_GTK_TRUENAME (f) = __get_gtk_font_truename (FONT_INSTANCE_GTK_FONT (f), 1);
+
+      if (NILP (FONT_INSTANCE_GTK_TRUENAME (f)))
+       {
+         /* Ok, just this once, return the font name as the truename.
+            (This is only used by Fequal() right now.) */
+         return f->name;
+       }
+    }
+  return (FONT_INSTANCE_GTK_TRUENAME (f));
+}
+
+static Lisp_Object
+gtk_font_instance_properties (struct Lisp_Font_Instance *f)
+{
+  Lisp_Object result = Qnil;
+
+  /* #### BILL!!! */
+  /* There seems to be no way to get this information under Gtk */
+  return result;
+}
+
+static Lisp_Object
+gtk_list_fonts (Lisp_Object pattern, Lisp_Object device)
+{
+  const char *patternext;
+
+  TO_EXTERNAL_FORMAT (LISP_STRING, pattern, C_STRING_ALLOCA, patternext, Qbinary);
+
+  return (__gtk_list_fonts_internal (patternext));
+}
+
+#ifdef MULE
+
+static int
+gtk_font_spec_matches_charset (struct device *d, Lisp_Object charset,
+                              const Bufbyte *nonreloc, Lisp_Object reloc,
+                              Bytecount offset, Bytecount length)
+{
+  if (UNBOUNDP (charset))
+    return 1;
+  /* Hack! Short font names don't have the registry in them,
+     so we just assume the user knows what they're doing in the
+     case of ASCII.  For other charsets, you gotta give the
+     long form; sorry buster.
+     */
+  if (EQ (charset, Vcharset_ascii))
+    {
+      const Bufbyte *the_nonreloc = nonreloc;
+      int i;
+      Bytecount the_length = length;
+
+      if (!the_nonreloc)
+       the_nonreloc = XSTRING_DATA (reloc);
+      fixup_internal_substring (nonreloc, reloc, offset, &the_length);
+      the_nonreloc += offset;
+      if (!memchr (the_nonreloc, '*', the_length))
+       {
+         for (i = 0;; i++)
+           {
+             const Bufbyte *new_nonreloc = (const Bufbyte *)
+               memchr (the_nonreloc, '-', the_length);
+             if (!new_nonreloc)
+               break;
+             new_nonreloc++;
+             the_length -= new_nonreloc - the_nonreloc;
+             the_nonreloc = new_nonreloc;
+           }
+
+         /* If it has less than 5 dashes, it's a short font.
+            Of course, long fonts always have 14 dashes or so, but short
+            fonts never have more than 1 or 2 dashes, so this is some
+            sort of reasonable heuristic. */
+         if (i < 5)
+           return 1;
+       }
+    }
+
+  return (fast_string_match (XCHARSET_REGISTRY (charset),
+                            nonreloc, reloc, offset, length, 1,
+                            ERROR_ME, 0) >= 0);
+}
+
+/* find a font spec that matches font spec FONT and also matches
+   (the registry of) CHARSET. */
+static Lisp_Object gtk_find_charset_font (Lisp_Object device, Lisp_Object font, Lisp_Object charset);
+
+#endif /* MULE */
+
+\f
+/************************************************************************/
+/*                            initialization                            */
+/************************************************************************/
+
+void
+syms_of_objects_gtk (void)
+{
+}
+
+void
+console_type_create_objects_gtk (void)
+{
+  /* object methods */
+
+  CONSOLE_HAS_METHOD (gtk, initialize_color_instance);
+  CONSOLE_HAS_METHOD (gtk, print_color_instance);
+  CONSOLE_HAS_METHOD (gtk, finalize_color_instance);
+  CONSOLE_HAS_METHOD (gtk, color_instance_equal);
+  CONSOLE_HAS_METHOD (gtk, color_instance_hash);
+  CONSOLE_HAS_METHOD (gtk, color_instance_rgb_components);
+  CONSOLE_HAS_METHOD (gtk, valid_color_name_p);
+
+  CONSOLE_HAS_METHOD (gtk, initialize_font_instance);
+  CONSOLE_HAS_METHOD (gtk, mark_font_instance);
+  CONSOLE_HAS_METHOD (gtk, print_font_instance);
+  CONSOLE_HAS_METHOD (gtk, finalize_font_instance);
+  CONSOLE_HAS_METHOD (gtk, font_instance_truename);
+  CONSOLE_HAS_METHOD (gtk, font_instance_properties);
+  CONSOLE_HAS_METHOD (gtk, list_fonts);
+#ifdef MULE
+  CONSOLE_HAS_METHOD (gtk, find_charset_font);
+  CONSOLE_HAS_METHOD (gtk, font_spec_matches_charset);
+#endif
+}
+
+void
+vars_of_objects_gtk (void)
+{
+}
+
+/* #### BILL!!! Try to make this go away eventually */
+/* X Specific stuff */
+#include <X11/Xatom.h>
+
+/* Unbounded, for sufficiently small values of infinity... */
+#define MAX_FONT_COUNT 5000
+
+#ifdef MULE
+/* find a font spec that matches font spec FONT and also matches
+   (the registry of) CHARSET. */
+static Lisp_Object
+gtk_find_charset_font (Lisp_Object device, Lisp_Object font, Lisp_Object charset)
+{
+  char **names;
+  int count = 0;
+  Lisp_Object result = Qnil;
+  const char *patternext;
+  int i;
+
+  TO_EXTERNAL_FORMAT (LISP_STRING, font, C_STRING_ALLOCA, patternext, Qbinary);
+
+  names = XListFonts (GDK_DISPLAY (),
+                     patternext, MAX_FONT_COUNT, &count);
+  /* ### This code seems awfully bogus -- mrb */
+  for (i = 0; i < count; i ++)
+    {
+      const Bufbyte *intname;
+      Bytecount intlen;
+
+      TO_INTERNAL_FORMAT (C_STRING, names[i], ALLOCA, (intname, intlen),
+                         Qctext);
+      if (gtk_font_spec_matches_charset (XDEVICE (device), charset,
+                                        intname, Qnil, 0, -1))
+       {
+         result = make_string ((char *) intname, intlen);
+         break;
+       }
+    }
+
+  if (names)
+    XFreeFontNames (names);
+
+  /* Check for a short font name. */
+  if (NILP (result)
+      && gtk_font_spec_matches_charset (XDEVICE (device), charset, 0,
+                                       font, 0, -1))
+    return font;
+
+  return result;
+}
+#endif /* MULE */
+
+/* Unbounded, for sufficiently small values of infinity... */
+#define MAX_FONT_COUNT 5000
+
+static int
+valid_font_name_p (Display *dpy, char *name)
+{
+  /* Maybe this should be implemented by callign XLoadFont and trapping
+     the error.  That would be a lot of work, and wasteful as hell, but
+     might be more correct.
+   */
+  int nnames = 0;
+  char **names = 0;
+  if (! name)
+    return 0;
+  names = XListFonts (dpy, name, 1, &nnames);
+  if (names)
+    XFreeFontNames (names);
+  return (nnames != 0);
+}
+
+Lisp_Object
+__get_gtk_font_truename (GdkFont *gdk_font, int expandp)
+{
+  Display *dpy = GDK_FONT_XDISPLAY (gdk_font);
+  GSList *names = ((GdkFontPrivate *) gdk_font)->names;
+  Lisp_Object font_name = Qnil;
+
+  while (names)
+    {
+      if (names->data)
+       {
+         if (valid_font_name_p (dpy, names->data))
+           {
+             if (!expandp)
+               {
+                 /* They want the wildcarded version */
+                 font_name = build_string (names->data);
+               }
+             else
+               {
+                 /* Need to expand out */
+                 int nnames = 0;
+                 char **x_font_names = 0;
+
+                 x_font_names = XListFonts (dpy, names->data, 1, &nnames);
+                 if (x_font_names)
+                   {
+                     font_name = build_string (x_font_names[0]);
+                     XFreeFontNames (x_font_names);
+                   }
+               }
+             break;
+           }
+       }
+      names = names->next;
+    }
+  return (font_name);
+}
+
+static Lisp_Object __gtk_list_fonts_internal (const char *pattern)
+{
+  char **names;
+  int count = 0;
+  Lisp_Object result = Qnil;
+
+  names = XListFonts (GDK_DISPLAY (), pattern, MAX_FONT_COUNT, &count);
+  while (count--)
+    result = Fcons (build_ext_string (names [count], Qbinary), result);
+  if (names)
+    XFreeFontNames (names);
+
+  return result;
+}

diff --git a/src/objects-gtk.h b/src/objects-gtk.h
new file mode 100644 (file)
index 0000000..7b74f5d
--- /dev/null
+++ b/src/objects-gtk.h
@@ -0,0 +1,68 @@
+/* Gtk-specific Lisp objects.
+   Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+   Copyright (C) 1995 Board of Trustees, University of Illinois.
+   Copyright (C) 1995, 1996 Ben Wing.
+
+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, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with:  Not in FSF. */
+/* Gtk version by William Perry */
+
+#ifndef _XEMACS_OBJECTS_GTK_H_
+#define _XEMACS_OBJECTS_GTK_H_
+
+#include "objects.h"
+
+#ifdef HAVE_GTK
+
+/*****************************************************************************
+ Color-Instance
+ ****************************************************************************/
+
+struct gtk_color_instance_data
+{
+  GdkColor *color;
+  char dealloc_on_gc;
+};
+
+#define GTK_COLOR_INSTANCE_DATA(c) ((struct gtk_color_instance_data *) (c)->data)
+#define COLOR_INSTANCE_GTK_COLOR(c) (GTK_COLOR_INSTANCE_DATA (c)->color)
+#define COLOR_INSTANCE_GTK_DEALLOC(c) (GTK_COLOR_INSTANCE_DATA (c)->dealloc_on_gc)
+
+int allocate_nearest_color (GdkColormap *screen_colormap, GdkVisual *visual,
+                                                       GdkColor *color_def);
+int gtk_parse_nearest_color (struct device *d, GdkColor *color, Bufbyte *name,
+                                                        Bytecount len, Error_behavior errb);
+
+/*****************************************************************************
+ Font-Instance
+ ****************************************************************************/
+
+struct gtk_font_instance_data
+{
+  /* Gtk-specific information */
+  Lisp_Object truename;
+  GdkFont *font;
+};
+
+#define GTK_FONT_INSTANCE_DATA(f) ((struct gtk_font_instance_data *) (f)->data)
+#define FONT_INSTANCE_GTK_FONT(f) (GTK_FONT_INSTANCE_DATA (f)->font)
+#define FONT_INSTANCE_GTK_TRUENAME(f) (GTK_FONT_INSTANCE_DATA (f)->truename)
+
+#endif /* HAVE_GTK */
+#endif /* _XEMACS_OBJECTS_GTK_H_ */

diff --git a/src/redisplay-gtk.c b/src/redisplay-gtk.c
new file mode 100644 (file)
index 0000000..f1ee926
--- /dev/null
+++ b/src/redisplay-gtk.c
@@ -0,0 +1,2051 @@
+/* X output and frame manipulation routines.
+   Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
+   Copyright (C) 1994 Lucid, Inc.
+   Copyright (C) 1995 Sun Microsystems, Inc.
+
+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, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with:  Not in FSF. */
+
+/* Author: Chuck Thompson */
+/* Gtk flavor by William Perry */
+
+/* Lots of work done by Ben Wing for Mule */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "console-gtk.h"
+#include "gccache-gtk.h"
+#include "glyphs-gtk.h"
+#include "objects-gtk.h"
+
+#include "buffer.h"
+#include "debug.h"
+#include "faces.h"
+#include "frame.h"
+#include "gutter.h"
+#include "redisplay.h"
+#include "sysdep.h"
+#include "window.h"
+
+#include "sysproc.h" /* for select() */
+
+#ifdef MULE
+#include "mule-ccl.h"
+#include "file-coding.h" /* for CCL conversion */
+#endif
+
+#define CONST const
+
+#define EOL_CURSOR_WIDTH       5
+
+static void gtk_output_pixmap (struct window *w, struct display_line *dl,
+                              Lisp_Object image_instance, int xpos,
+                              int xoffset,
+                              int start_pixpos, int width, face_index findex,
+                              int cursor_start, int cursor_width,
+                              int cursor_height);
+static void gtk_output_vertical_divider (struct window *w, int clear);
+static void gtk_output_blank (struct window *w, struct display_line *dl,
+                             struct rune *rb, int start_pixpos,
+                             int cursor_start, int cursor_width);
+static void gtk_output_hline (struct window *w, struct display_line *dl,
+                             struct rune *rb);
+static void gtk_redraw_exposed_window (struct window *w, int x, int y,
+                                      int width, int height);
+static void gtk_redraw_exposed_windows (Lisp_Object window, int x, int y,
+                                       int width, int height);
+static void gtk_clear_region (Lisp_Object locale, struct device* d, struct frame* f,
+                             face_index findex, int x, int y,
+                             int width, int height, Lisp_Object fcolor, Lisp_Object bcolor,
+                             Lisp_Object background_pixmap);
+static void gtk_output_eol_cursor (struct window *w, struct display_line *dl,
+                                  int xpos, face_index findex);
+static void gtk_clear_frame (struct frame *f);
+static void gtk_clear_frame_windows (Lisp_Object window);
+static void gtk_bevel_modeline (struct window *w, struct display_line *dl);
+
+#if 0
+static void __describe_gc (GdkGC *);
+#endif
+
+struct textual_run
+{
+  Lisp_Object charset;
+  unsigned char *ptr;
+  int len;
+  int dimension;
+};
+
+/* Separate out the text in DYN into a series of textual runs of a
+   particular charset.  Also convert the characters as necessary into
+   the format needed by XDrawImageString(), XDrawImageString16(), et
+   al.  (This means converting to one or two byte format, possibly
+   tweaking the high bits, and possibly running a CCL program.) You
+   must pre-allocate the space used and pass it in. (This is done so
+   you can alloca() the space.)  You need to allocate (2 * len) bytes
+   of TEXT_STORAGE and (len * sizeof (struct textual_run)) bytes of
+   RUN_STORAGE, where LEN is the length of the dynarr.
+
+   Returns the number of runs actually used. */
+
+static int
+separate_textual_runs (unsigned char *text_storage,
+                      struct textual_run *run_storage,
+                      CONST Emchar *str, Charcount len)
+{
+  Lisp_Object prev_charset = Qunbound; /* not Qnil because that is a
+                                         possible valid charset when
+                                         MULE is not defined */
+  int runs_so_far = 0;
+  int i;
+#ifdef MULE
+  struct ccl_program char_converter;
+  int need_ccl_conversion = 0;
+#endif
+
+  for (i = 0; i < len; i++)
+    {
+      Emchar ch = str[i];
+      Lisp_Object charset;
+      int byte1, byte2;
+      int dimension;
+      int graphic;
+
+      BREAKUP_CHAR (ch, charset, byte1, byte2);
+      dimension = XCHARSET_DIMENSION (charset);
+      graphic   = XCHARSET_GRAPHIC   (charset);
+
+      if (!EQ (charset, prev_charset))
+       {
+         run_storage[runs_so_far].ptr       = text_storage;
+         run_storage[runs_so_far].charset   = charset;
+         run_storage[runs_so_far].dimension = dimension;
+
+         if (runs_so_far)
+           {
+             run_storage[runs_so_far - 1].len =
+               text_storage - run_storage[runs_so_far - 1].ptr;
+             if (run_storage[runs_so_far - 1].dimension == 2)
+               run_storage[runs_so_far - 1].len >>= 1;
+           }
+         runs_so_far++;
+         prev_charset = charset;
+#ifdef MULE
+         {
+           Lisp_Object ccl_prog = XCHARSET_CCL_PROGRAM (charset);
+           need_ccl_conversion = !NILP (ccl_prog);
+           if (need_ccl_conversion)
+             setup_ccl_program (&char_converter, ccl_prog);
+         }
+#endif
+       }
+
+      if (graphic == 0)
+       {
+         byte1 &= 0x7F;
+         byte2 &= 0x7F;
+       }
+      else if (graphic == 1)
+       {
+         byte1 |= 0x80;
+         byte2 |= 0x80;
+       }
+#ifdef MULE
+      if (need_ccl_conversion)
+       {
+         char_converter.reg[0] = XCHARSET_ID (charset);
+         char_converter.reg[1] = byte1;
+         char_converter.reg[2] = byte2;
+         ccl_driver (&char_converter, 0, 0, 0, 0, CCL_MODE_ENCODING);
+         byte1 = char_converter.reg[1];
+         byte2 = char_converter.reg[2];
+       }
+#endif
+      *text_storage++ = (unsigned char) byte1;
+      if (dimension == 2)
+       *text_storage++ = (unsigned char) byte2;
+    }
+
+  if (runs_so_far)
+    {
+      run_storage[runs_so_far - 1].len =
+       text_storage - run_storage[runs_so_far - 1].ptr;
+      if (run_storage[runs_so_far - 1].dimension == 2)
+       run_storage[runs_so_far - 1].len >>= 1;
+    }
+
+  return runs_so_far;
+}
+
+/****************************************************************************/
+/*                                                                          */
+/*                          Gtk output routines                             */
+/*                                                                          */
+/****************************************************************************/
+
+static int
+gtk_text_width_single_run (struct face_cachel *cachel, struct textual_run *run)
+{
+  Lisp_Object font_inst = FACE_CACHEL_FONT (cachel, run->charset);
+  struct Lisp_Font_Instance *fi = XFONT_INSTANCE (font_inst);
+
+  if (!fi->proportional_p)
+  {
+    return fi->width * run->len;
+  }
+  else
+    {
+      if (run->dimension == 2)
+       {
+         stderr_out ("Measuring wide characters\n");
+         return gdk_text_width_wc (FONT_INSTANCE_GTK_FONT (fi),
+                                   (GdkWChar *) run->ptr, run->len);
+       }
+      else
+       {
+         return gdk_text_width (FONT_INSTANCE_GTK_FONT (fi),
+                                (char *) run->ptr, run->len);
+       }
+    }
+}
+
+/*
+   gtk_text_width
+
+   Given a string and a face, return the string's length in pixels when
+   displayed in the font associated with the face.
+   */
+
+static int
+gtk_text_width (struct frame *f, struct face_cachel *cachel, CONST Emchar *str,
+               Charcount len)
+{
+  int width_so_far = 0;
+  unsigned char *text_storage = (unsigned char *) alloca (2 * len);
+  struct textual_run *runs = alloca_array (struct textual_run, len);
+  int nruns;
+  int i;
+
+  nruns = separate_textual_runs (text_storage, runs, str, len);
+
+  for (i = 0; i < nruns; i++)
+    width_so_far += gtk_text_width_single_run (cachel, runs + i);
+
+  return width_so_far;
+}
+
+/*****************************************************************************
+ gtk_divider_height
+
+ Return the height of the horizontal divider.  This is a function because
+ divider_height is a device method.
+
+ #### If we add etched horizontal divider lines this will have to get
+ smarter.
+ ****************************************************************************/
+static int
+gtk_divider_height (void)
+{
+  return 2;
+}
+
+/*****************************************************************************
+ gtk_eol_cursor_width
+
+ Return the width of the end-of-line cursor.  This is a function
+ because eol_cursor_width is a device method.
+ ****************************************************************************/
+static int
+gtk_eol_cursor_width (void)
+{
+  return EOL_CURSOR_WIDTH;
+}
+
+/*****************************************************************************
+ gtk_output_display_block
+
+ Given a display line, a block number for that start line, output all
+ runes between start and end in the specified display block.
+ ****************************************************************************/
+static void
+gtk_output_display_block (struct window *w, struct display_line *dl, int block,
+                         int start, int end, int start_pixpos, int cursor_start,
+                         int cursor_width, int cursor_height)
+{
+  struct frame *f = XFRAME (w->frame);
+  Emchar_dynarr *buf = Dynarr_new (Emchar);
+  Lisp_Object window;
+
+  struct display_block *db = Dynarr_atp (dl->display_blocks, block);
+  rune_dynarr *rba = db->runes;
+  struct rune *rb;
+
+  int elt = start;
+  face_index findex;
+  int xpos, width;
+  Lisp_Object charset = Qunbound; /* Qnil is a valid charset when
+                                    MULE is not defined */
+
+  XSETWINDOW (window, w);
+  rb = Dynarr_atp (rba, start);
+
+  if (!rb)
+    {
+      /* Nothing to do so don't do anything. */
+      return;
+    }
+  else
+    {
+      findex = rb->findex;
+      xpos = rb->xpos;
+      width = 0;
+      if (rb->type == RUNE_CHAR)
+       charset = CHAR_CHARSET (rb->object.chr.ch);
+    }
+
+  if (end < 0)
+    end = Dynarr_length (rba);
+  Dynarr_reset (buf);
+
+  while (elt < end)
+    {
+      rb = Dynarr_atp (rba, elt);
+
+      if (rb->findex == findex && rb->type == RUNE_CHAR
+         && rb->object.chr.ch != '\n' && rb->cursor_type != CURSOR_ON
+         && EQ (charset, CHAR_CHARSET (rb->object.chr.ch)))
+       {
+         Dynarr_add (buf, rb->object.chr.ch);
+         width += rb->width;
+         elt++;
+       }
+      else
+       {
+         if (Dynarr_length (buf))
+           {
+             gtk_output_string (w, dl, buf, xpos, 0, start_pixpos, width,
+                                findex, 0, cursor_start, cursor_width,
+                                cursor_height);
+             xpos = rb->xpos;
+             width = 0;
+           }
+         Dynarr_reset (buf);
+         width = 0;
+
+         if (rb->type == RUNE_CHAR)
+           {
+             findex = rb->findex;
+             xpos = rb->xpos;
+             charset = CHAR_CHARSET (rb->object.chr.ch);
+
+             if (rb->cursor_type == CURSOR_ON)
+               {
+                 if (rb->object.chr.ch == '\n')
+                   {
+                     gtk_output_eol_cursor (w, dl, xpos, findex);
+                   }
+                 else
+                   {
+                     Dynarr_add (buf, rb->object.chr.ch);
+                     gtk_output_string (w, dl, buf, xpos, 0, start_pixpos,
+                                        rb->width, findex, 1,
+                                        cursor_start, cursor_width,
+                                        cursor_height);
+                     Dynarr_reset (buf);
+                   }
+
+                 xpos += rb->width;
+                 elt++;
+               }
+             else if (rb->object.chr.ch == '\n')
+               {
+                 /* Clear in case a cursor was formerly here. */
+                 int height = dl->ascent + dl->descent - dl->clip;
+
+                 redisplay_clear_region (window, findex, xpos, dl->ypos - dl->ascent,
+                                         rb->width, height);
+                 elt++;
+               }
+           }
+         else if (rb->type == RUNE_BLANK || rb->type == RUNE_HLINE)
+           {
+             if (rb->type == RUNE_BLANK)
+               gtk_output_blank (w, dl, rb, start_pixpos, cursor_start,
+                                 cursor_width);
+             else
+               {
+                 /* #### Our flagging of when we need to redraw the
+                     modeline shadows sucks.  Since RUNE_HLINE is only used
+                     by the modeline at the moment it is a good bet
+                     that if it gets redrawn then we should also
+                     redraw the shadows.  This won't be true forever.
+                     We borrow the shadow_thickness_changed flag for
+                     now. */
+                 w->shadow_thickness_changed = 1;
+                 gtk_output_hline (w, dl, rb);
+               }
+
+             elt++;
+             if (elt < end)
+               {
+                 rb = Dynarr_atp (rba, elt);
+
+                 findex = rb->findex;
+                 xpos = rb->xpos;
+               }
+           }
+         else if (rb->type == RUNE_DGLYPH)
+           {
+             Lisp_Object instance;
+             struct display_box dbox;
+             struct display_glyph_area dga;
+             redisplay_calculate_display_boxes (dl, rb->xpos, rb->object.dglyph.xoffset,
+                                                start_pixpos, rb->width,
+                                                &dbox, &dga);
+
+             XSETWINDOW (window, w);
+             instance = glyph_image_instance (rb->object.dglyph.glyph,
+                                              window, ERROR_ME_NOT, 1);
+             findex = rb->findex;
+
+             if (IMAGE_INSTANCEP (instance))
+               switch (XIMAGE_INSTANCE_TYPE (instance))
+                 {
+                 case IMAGE_TEXT:
+                   {
+                     /* #### This is way losing.  See the comment in
+                        add_glyph_rune(). */
+                     Lisp_Object string =
+                       XIMAGE_INSTANCE_TEXT_STRING (instance);
+                     convert_bufbyte_string_into_emchar_dynarr
+                       (XSTRING_DATA (string), XSTRING_LENGTH (string), buf);
+
+                     gtk_output_string (w, dl, buf, xpos,
+                                        rb->object.dglyph.xoffset,
+                                        start_pixpos, -1, findex,
+                                        (rb->cursor_type == CURSOR_ON),
+                                        cursor_start, cursor_width,
+                                        cursor_height);
+                     Dynarr_reset (buf);
+                   }
+                   break;
+
+                 case IMAGE_MONO_PIXMAP:
+                 case IMAGE_COLOR_PIXMAP:
+                   gtk_output_pixmap (w, dl, instance, xpos,
+                                      rb->object.dglyph.xoffset, start_pixpos,
+                                      rb->width, findex, cursor_start,
+                                      cursor_width, cursor_height);
+                   break;
+
+                 case IMAGE_POINTER:
+                   abort ();
+
+                 case IMAGE_WIDGET:
+                     if (EQ (XIMAGE_INSTANCE_WIDGET_TYPE (instance),
+                             Qlayout))
+                       {
+                         redisplay_output_layout (window, instance, &dbox,
+                                                  &dga, findex,
+                                                  cursor_start, cursor_width,
+                                                  cursor_height);
+                         break;
+                       }
+
+                 case IMAGE_SUBWINDOW:
+                   redisplay_output_subwindow (w, instance, &dbox, &dga,
+                                               findex, cursor_start,
+                                               cursor_width, cursor_height);
+                   break;
+
+                 case IMAGE_NOTHING:
+                   /* nothing is as nothing does */
+                   break;
+
+                 default:
+                   abort ();
+                 }
+
+             xpos += rb->width;
+             elt++;
+           }
+         else
+           abort ();
+       }
+    }
+
+  if (Dynarr_length (buf))
+    gtk_output_string (w, dl, buf, xpos, 0, start_pixpos, width, findex,
+                      0, cursor_start, cursor_width, cursor_height);
+
+  /* #### This is really conditionalized well for optimized
+     performance. */
+  if (dl->modeline
+      && !EQ (Qzero, w->modeline_shadow_thickness)
+      && (f->clear
+         || f->windows_structure_changed
+         || w->shadow_thickness_changed))
+    gtk_bevel_modeline (w, dl);
+
+  Dynarr_free (buf);
+}
+
+/*****************************************************************************
+ gtk_bevel_modeline
+
+ Draw a 3d border around the modeline on window W.
+ ****************************************************************************/
+static void
+gtk_bevel_modeline (struct window *w, struct display_line *dl)
+{
+  struct frame *f = XFRAME (w->frame);
+  int shadow_thickness = MODELINE_SHADOW_THICKNESS (w);
+  int x,y, width, height;
+
+  x = WINDOW_MODELINE_LEFT (w);
+  width = WINDOW_MODELINE_RIGHT (w) - x;
+  y = dl->ypos - dl->ascent - shadow_thickness;
+  height = dl->ascent + dl->descent + 2 * shadow_thickness;
+
+  gtk_output_shadows (f, x, y, width, height, shadow_thickness);
+}
+
+/*****************************************************************************
+ gtk_get_gc
+
+ Given a number of parameters return a GC with those properties.
+ ****************************************************************************/
+GdkGC *
+gtk_get_gc (struct device *d, Lisp_Object font, Lisp_Object fg, Lisp_Object bg,
+           Lisp_Object bg_pmap, Lisp_Object lwidth)
+{
+  GdkGCValues gcv;
+  unsigned long mask;
+
+  memset (&gcv, ~0, sizeof (gcv));
+  gcv.graphics_exposures = FALSE;
+  /* Make absolutely sure that we don't pick up a clipping region in
+     the GC returned by this function. */
+  gcv.clip_mask = 0;
+  gcv.clip_x_origin = 0;
+  gcv.clip_y_origin = 0;
+  gcv.fill = GDK_SOLID;
+  mask = GDK_GC_EXPOSURES | GDK_GC_CLIP_MASK | GDK_GC_CLIP_X_ORIGIN | GDK_GC_CLIP_Y_ORIGIN;
+  mask |= GDK_GC_FILL;
+
+  if (!NILP (font))
+    {
+      gcv.font = FONT_INSTANCE_GTK_FONT (XFONT_INSTANCE (font));
+      mask |= GDK_GC_FONT;
+    }
+
+  /* evil kludge! */
+  if (!NILP (fg) && !COLOR_INSTANCEP (fg) && !INTP (fg))
+    {
+      /* #### I fixed once case where this was getting it.  It was a
+         bad macro expansion (compiler bug). */
+      fprintf (stderr, "Help! gtk_get_gc got a bogus fg value! fg = ");
+      debug_print (fg);
+      fg = Qnil;
+    }
+
+  if (!NILP (fg))
+    {
+      if (COLOR_INSTANCEP (fg))
+       gcv.foreground = * COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (fg));
+      else
+       gcv.foreground.pixel = XINT (fg);
+      mask |= GDK_GC_FOREGROUND;
+    }
+
+  if (!NILP (bg))
+    {
+      if (COLOR_INSTANCEP (bg))
+       gcv.background = * COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (bg));
+      else
+       gcv.background.pixel = XINT (fg);
+      mask |= GDK_GC_BACKGROUND;
+    }
+
+  if (IMAGE_INSTANCEP (bg_pmap)
+      && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pmap)))
+    {
+      if (XIMAGE_INSTANCE_PIXMAP_DEPTH (bg_pmap) == 0)
+       {
+         gcv.fill = GDK_OPAQUE_STIPPLED;
+         gcv.stipple = XIMAGE_INSTANCE_GTK_PIXMAP (bg_pmap);
+         mask |= (GDK_GC_STIPPLE | GDK_GC_FILL);
+       }
+      else
+       {
+         gcv.fill = GDK_TILED;
+         gcv.tile = XIMAGE_INSTANCE_GTK_PIXMAP (bg_pmap);
+         mask |= (GDK_GC_TILE | GDK_GC_FILL);
+       }
+    }
+
+  if (!NILP (lwidth))
+    {
+      gcv.line_width = XINT (lwidth);
+      mask |= GDK_GC_LINE_WIDTH;
+    }
+
+  return gc_cache_lookup (DEVICE_GTK_GC_CACHE (d), &gcv, mask);
+}
+
+/*****************************************************************************
+ gtk_output_string
+
+ Given a string and a starting position, output that string in the
+ given face.  If cursor is true, draw a cursor around the string.
+ Correctly handles multiple charsets in the string.
+
+ The meaning of the parameters is something like this:
+
+ W             Window that the text is to be displayed in.
+ DL            Display line that this text is on.  The values in the
+               structure are used to determine the vertical position and
+               clipping range of the text.
+ BUF           Dynamic array of Emchars specifying what is actually to be
+               drawn.
+ XPOS          X position in pixels where the text should start being drawn.
+ XOFFSET       Number of pixels to be chopped off the left side of the
+               text.  The effect is as if the text were shifted to the
+               left this many pixels and clipped at XPOS.
+ CLIP_START    Clip everything left of this X position.
+ WIDTH         Clip everything right of XPOS + WIDTH.
+ FINDEX                Index for the face cache element describing how to display
+               the text.
+ CURSOR                #### I don't understand this.  There's something
+               strange and overcomplexified with this variable.
+               Chuck, explain please?
+ CURSOR_START  Starting X position of cursor.
+ CURSOR_WIDTH  Width of cursor in pixels.
+ CURSOR_HEIGHT Height of cursor in pixels.
+
+ Starting Y position of cursor is the top of the text line.
+ The cursor is drawn sometimes whether or not CURSOR is set. ???
+ ****************************************************************************/
+void
+gdk_draw_text_image (GdkDrawable *drawable,
+                    GdkFont     *font,
+                    GdkGC       *gc,
+                    gint         x,
+                    gint         y,
+                    const gchar *text,
+                    gint         text_length);
+
+void
+gtk_output_string (struct window *w, struct display_line *dl,
+                  Emchar_dynarr *buf, int xpos, int xoffset, int clip_start,
+                  int width, face_index findex, int cursor,
+                  int cursor_start, int cursor_width, int cursor_height)
+{
+  /* General variables */
+  struct frame *f = XFRAME (w->frame);
+  struct device *d = XDEVICE (f->device);
+  Lisp_Object device;
+  Lisp_Object window;
+  GdkWindow *x_win = GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (f));
+
+  int clip_end;
+
+  /* Cursor-related variables */
+  int focus = EQ (w->frame, DEVICE_FRAME_WITH_FOCUS_REAL (d));
+  int cursor_clip;
+  Lisp_Object bar_cursor_value = symbol_value_in_buffer (Qbar_cursor,
+                                                        WINDOW_BUFFER (w));
+  struct face_cachel *cursor_cachel = 0;
+
+  /* Text-related variables */
+  Lisp_Object bg_pmap;
+  GdkGC *bgc, *gc;
+  int height;
+  int len = Dynarr_length (buf);
+  unsigned char *text_storage = (unsigned char *) alloca (2 * len);
+  struct textual_run *runs = alloca_array (struct textual_run, len);
+  int nruns;
+  int i;
+  struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, findex);
+
+  XSETDEVICE (device, d);
+  XSETWINDOW (window, w);
+
+  if (width < 0)
+    width = gtk_text_width (f, cachel, Dynarr_atp (buf, 0), Dynarr_length (buf));
+  height = dl->ascent + dl->descent - dl->clip;
+
+  /* Regularize the variables passed in. */
+
+  if (clip_start < xpos)
+    clip_start = xpos;
+  clip_end = xpos + width;
+  if (clip_start >= clip_end)
+    /* It's all clipped out. */
+    return;
+
+  xpos -= xoffset;
+
+  nruns = separate_textual_runs (text_storage, runs, Dynarr_atp (buf, 0),
+                                Dynarr_length (buf));
+
+  cursor_clip = (cursor_start >= clip_start &&
+                cursor_start < clip_end);
+
+  /* This cursor code is really a mess. */
+  if (!NILP (w->text_cursor_visible_p)
+      && (cursor
+         || cursor_clip
+         || (cursor_width
+             && (cursor_start + cursor_width >= clip_start)
+             && !NILP (bar_cursor_value))))
+    {
+      /* These have to be in separate statements in order to avoid a
+         compiler bug. */
+      face_index sucks = get_builtin_face_cache_index (w, Vtext_cursor_face);
+      cursor_cachel = WINDOW_FACE_CACHEL (w, sucks);
+
+      /* We have to reset this since any call to WINDOW_FACE_CACHEL
+         may cause the cache to resize and any pointers to it to
+         become invalid. */
+      cachel = WINDOW_FACE_CACHEL (w, findex);
+    }
+
+  bg_pmap = cachel->background_pixmap;
+  if (!IMAGE_INSTANCEP (bg_pmap)
+      || !IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pmap)))
+    bg_pmap = Qnil;
+
+  if ((cursor && focus && NILP (bar_cursor_value)
+       && !NILP (w->text_cursor_visible_p)) || NILP (bg_pmap))
+    bgc = 0;
+  else
+    bgc = gtk_get_gc (d, Qnil, cachel->foreground, cachel->background,
+                     bg_pmap, Qnil);
+
+  if (bgc)
+    gdk_draw_rectangle (GDK_DRAWABLE (x_win), bgc, TRUE, clip_start,
+                       dl->ypos - dl->ascent, clip_end - clip_start,
+                       height);
+
+  for (i = 0; i < nruns; i++)
+    {
+      Lisp_Object font = FACE_CACHEL_FONT (cachel, runs[i].charset);
+      struct Lisp_Font_Instance *fi = XFONT_INSTANCE (font);
+      GdkFont *gdk_font = FONT_INSTANCE_GTK_FONT (fi);
+      int this_width;
+      int need_clipping;
+
+      if (EQ (font, Vthe_null_font_instance))
+       continue;
+
+      this_width = gtk_text_width_single_run (cachel, runs + i);
+      need_clipping = (dl->clip || clip_start > xpos ||
+                      clip_end < xpos + this_width);
+
+      /* XDrawImageString only clears the area equal to the height of
+        the given font.  It is possible that a font is being displayed
+        on a line taller than it is, so this would cause us to fail to
+        clear some areas. */
+      if ((int) fi->height < (int) (height + dl->clip))
+       {
+         int clear_start = max (xpos, clip_start);
+         int clear_end = min (xpos + this_width, clip_end);
+
+         if (cursor)
+           {
+             int ypos1_line, ypos1_string, ypos2_line, ypos2_string;
+
+             ypos1_string = dl->ypos - fi->ascent;
+             ypos2_string = dl->ypos + fi->descent;
+             ypos1_line = dl->ypos - dl->ascent;
+             ypos2_line = dl->ypos + dl->descent - dl->clip;
+
+             /* Make sure we don't clear below the real bottom of the
+                line. */
+             if (ypos1_string > ypos2_line)
+               ypos1_string = ypos2_line;
+             if (ypos2_string > ypos2_line)
+               ypos2_string = ypos2_line;
+
+             if (ypos1_line < ypos1_string)
+               {
+                 redisplay_clear_region (window, findex, clear_start, ypos1_line,
+                                   clear_end - clear_start,
+                                   ypos1_string - ypos1_line);
+               }
+
+             if (ypos2_line > ypos2_string)
+               {
+                 redisplay_clear_region (window, findex, clear_start, ypos2_string,
+                                         clear_end - clear_start,
+                                         ypos2_line - ypos2_string);
+               }
+           }
+         else
+           {
+             redisplay_clear_region (window, findex, clear_start,
+                                     dl->ypos - dl->ascent, clear_end - clear_start,
+                                     height);
+           }
+       }
+
+      if (cursor && cursor_cachel && focus && NILP (bar_cursor_value))
+      {
+       gc = gtk_get_gc (d, font, cursor_cachel->foreground,
+                        cursor_cachel->background, Qnil, Qnil);
+      }
+      else
+      {
+       gc = gtk_get_gc (d, font, cachel->foreground, cachel->background,
+                        Qnil, Qnil);
+      }
+
+      if (need_clipping)
+       {
+         GdkRectangle clip_box;
+
+         clip_box.x = 0;
+         clip_box.y = 0;
+         clip_box.width = clip_end - clip_start;
+         clip_box.height = height;
+
+         gdk_gc_set_clip_rectangle (gc, &clip_box);
+         gdk_gc_set_clip_origin (gc, clip_start, dl->ypos - dl->ascent);
+       }
+
+      /* The X specific called different functions (XDraw*String
+         vs. XDraw*String16), but apparently gdk_draw_text takes care
+         of that for us.
+
+        BUT, gdk_draw_text also does too much, by dividing the length
+        by 2.  So we fake them out my multiplying the length by the
+        dimension of the text.  This will do the right thing for
+        single-dimension runs as well of course.
+      */
+      (bgc ? gdk_draw_text : gdk_draw_text_image) (GDK_DRAWABLE (x_win), gdk_font, gc, xpos,
+                                                  dl->ypos, (char *) runs[i].ptr,
+                                                  runs[i].len * runs[i].dimension);
+
+      /* We draw underlines in the same color as the text. */
+      if (cachel->underline)
+       {
+         unsigned long upos, uthick;
+
+         /* Cannot get at font properties in Gtk, so we resort to
+             guessing */
+         upos = dl->descent / 2;
+         uthick = 1;
+
+         if (dl->ypos + upos < dl->ypos + dl->descent - dl->clip)
+           {
+             if (dl->ypos + upos + uthick > dl->ypos + dl->descent - dl->clip)
+               uthick = dl->descent - dl->clip - upos;
+
+             if (uthick == 1)
+               {
+                 gdk_draw_line (GDK_DRAWABLE (x_win), gc, xpos, dl->ypos + upos,
+                            xpos + this_width, dl->ypos + upos);
+               }
+             else if (uthick > 1)
+               {
+                   gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc, TRUE, xpos,
+                                       dl->ypos + upos, this_width, uthick);
+               }
+           }
+       }
+
+      if (cachel->strikethru) {
+       unsigned long ascent,descent,upos, uthick;
+       GdkFont *gfont = FONT_INSTANCE_GTK_FONT (XFONT_INSTANCE (font));
+
+       /* Cannot get at font properties in Gtk, so we resort to
+           guessing */
+
+       ascent = gfont->ascent;
+       descent = gfont->descent;
+       uthick = 1;
+
+       upos = ascent - ((ascent + descent) / 2) + 1;
+
+       /* Generally, upos will be positive (above the baseline),so subtract */
+       if (dl->ypos - upos < dl->ypos + dl->descent - dl->clip)
+         {
+           if (dl->ypos - upos + uthick > dl->ypos + dl->descent - dl->clip)
+             uthick = dl->descent - dl->clip + upos;
+
+           if (uthick == 1)
+             {
+                 gdk_draw_line (GDK_DRAWABLE (x_win), gc, xpos, dl->ypos - upos,
+                                xpos + this_width, dl->ypos - upos);
+             }
+           else if (uthick > 1)
+             {
+                 gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc, TRUE, xpos, dl->ypos + upos,
+                                     this_width, uthick);
+             }
+         }
+      }
+
+      /* Restore the GC */
+      if (need_clipping)
+       {
+           gdk_gc_set_clip_rectangle (gc, NULL);
+           gdk_gc_set_clip_origin (gc, 0, 0);
+       }
+
+      /* If we are actually superimposing the cursor then redraw with just
+        the appropriate section highlighted. */
+      if (cursor_clip && !cursor && focus && cursor_cachel)
+       {
+         GdkGC *cgc;
+         GdkRectangle clip_box;
+
+         cgc = gtk_get_gc (d, font, cursor_cachel->foreground,
+                           cursor_cachel->background, Qnil, Qnil);
+
+         clip_box.x = 0;
+         clip_box.y = 0;
+         clip_box.width = cursor_width;
+         clip_box.height = height;
+
+         gdk_gc_set_clip_rectangle (cgc, &clip_box);
+         gdk_gc_set_clip_origin (cgc, cursor_start, dl->ypos - dl->ascent);
+
+         /* The X specific called different functions (XDraw*String
+            vs. XDraw*String16), but apparently gdk_draw_text takes care
+            of that for us.
+
+            BUT, gdk_draw_text also does too much, by dividing the
+            length by 2.  So we fake them out my multiplying the
+            length by the dimension of the text.  This will do the
+            right thing for single-dimension runs as well of course.
+         */
+         gdk_draw_text_image (GDK_DRAWABLE (x_win), gdk_font, cgc, xpos,
+                              dl->ypos, (char *) runs[i].ptr,
+                              runs[i].len * runs[i].dimension);
+
+         gdk_gc_set_clip_rectangle (cgc, NULL);
+         gdk_gc_set_clip_origin (cgc, 0, 0);
+       }
+
+      xpos += this_width;
+    }
+
+  /* Draw the non-focus box or bar-cursor as needed. */
+  /* Can't this logic be simplified? */
+  if (cursor_cachel
+      && ((cursor && !focus && NILP (bar_cursor_value))
+         || (cursor_width
+             && (cursor_start + cursor_width >= clip_start)
+             && !NILP (bar_cursor_value))))
+    {
+      int tmp_height, tmp_y;
+      int bar_width = EQ (bar_cursor_value, Qt) ? 1 : 2;
+      int need_clipping = (cursor_start < clip_start
+                          || clip_end < cursor_start + cursor_width);
+
+      /* #### This value is correct (as far as I know) because
+        all of the times we need to draw this cursor, we will
+        be called with exactly one character, so we know we
+        can always use runs[0].
+
+        This is bogus as all hell, however.  The cursor handling in
+        this function is way bogus and desperately needs to be
+        cleaned up. (In particular, the drawing of the cursor should
+        really really be separated out of this function.  This may be
+        a bit tricky now because this function itself does way too
+        much stuff, a lot of which needs to be moved into
+        redisplay.c) This is the only way to be able to easily add
+        new cursor types or (e.g.) make the bar cursor be able to
+        span two characters instead of overlaying just one. */
+      int bogusly_obtained_ascent_value =
+       XFONT_INSTANCE (FACE_CACHEL_FONT (cachel, runs[0].charset))->ascent;
+
+      if (!NILP (bar_cursor_value))
+       {
+         gc = gtk_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil,
+                          make_int (bar_width));
+       }
+      else
+       {
+         gc = gtk_get_gc (d, Qnil, cursor_cachel->background,
+                          Qnil, Qnil, Qnil);
+       }
+
+      tmp_y = dl->ypos - bogusly_obtained_ascent_value;
+      tmp_height = cursor_height;
+      if (tmp_y + tmp_height > (int) (dl->ypos - dl->ascent + height))
+       {
+         tmp_y = dl->ypos - dl->ascent + height - tmp_height;
+         if (tmp_y < (int) (dl->ypos - dl->ascent))
+           tmp_y = dl->ypos - dl->ascent;
+         tmp_height = dl->ypos - dl->ascent + height - tmp_y;
+       }
+
+      if (need_clipping)
+       {
+         GdkRectangle clip_box;
+         clip_box.x = 0;
+         clip_box.y = 0;
+         clip_box.width = clip_end - clip_start;
+         clip_box.height = tmp_height;
+
+         gdk_gc_set_clip_rectangle (gc, &clip_box);
+         gdk_gc_set_clip_origin (gc, clip_start, tmp_y);
+       }
+
+      if (!focus && NILP (bar_cursor_value))
+       {
+           gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc, FALSE,
+                               cursor_start, tmp_y,
+                               cursor_width - 1, tmp_height - 1);
+       }
+      else if (focus && !NILP (bar_cursor_value))
+       {
+           gdk_draw_line (GDK_DRAWABLE (x_win), gc,
+                          cursor_start + bar_width - 1, tmp_y,
+                          cursor_start + bar_width - 1, tmp_y + tmp_height - 1);
+       }
+
+      /* Restore the GC */
+      if (need_clipping)
+       {
+           gdk_gc_set_clip_rectangle (gc, NULL);
+           gdk_gc_set_clip_origin (gc, 0, 0);
+       }
+    }
+}
+
+static void
+our_draw_bitmap (GdkDrawable *drawable,
+                GdkGC       *gc,
+                GdkPixmap   *src,
+                gint         xsrc,
+                gint         ysrc,
+                gint         xdest,
+                gint         ydest,
+                gint         width,
+                gint         height);
+
+void
+gtk_output_gdk_pixmap (struct frame *f, struct Lisp_Image_Instance *p, int x,
+                      int y, int clip_x, int clip_y, int clip_width,
+                      int clip_height, int width, int height, int pixmap_offset,
+                      GdkColor *fg, GdkColor *bg, GdkGC *override_gc)
+{
+  struct device *d = XDEVICE (f->device);
+  GdkWindow *x_win = GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (f));
+
+  GdkGC *gc;
+  GdkGCValues gcv;
+  unsigned long pixmap_mask;
+  int need_clipping = (clip_x || clip_y);
+
+  if (!override_gc)
+    {
+      memset (&gcv, ~0, sizeof (gcv));
+      gcv.graphics_exposures = FALSE;
+      gcv.foreground = *fg;
+      gcv.background = *bg;
+      pixmap_mask = GDK_GC_FOREGROUND | GDK_GC_BACKGROUND | GDK_GC_EXPOSURES;
+
+      if (IMAGE_INSTANCE_GTK_MASK (p))
+       {
+         gcv.function = GDK_COPY;
+         gcv.clip_mask = IMAGE_INSTANCE_GTK_MASK (p);
+         gcv.clip_x_origin = x;
+         gcv.clip_y_origin = y - pixmap_offset;
+         pixmap_mask |= (GDK_GC_FUNCTION | GDK_GC_CLIP_MASK | GDK_GC_CLIP_X_ORIGIN |
+                         GDK_GC_CLIP_Y_ORIGIN);
+         /* Can't set a clip rectangle below because we already have a mask.
+            We could conceivably create a new clipmask by zeroing out
+            everything outside the clip region.  Is it worth it?
+            Is it possible to get an equivalent effect by changing the
+            args to XCopyArea below rather than messing with a clip box?
+            - dkindred@cs.cmu.edu */
+         need_clipping = 0;
+       }
+
+      gc = gc_cache_lookup (DEVICE_GTK_GC_CACHE (d), &gcv, pixmap_mask);
+    }
+  else
+    {
+      gc = override_gc;
+      /* override_gc might have a mask already--we don't want to nuke it.
+        Maybe we can insist that override_gc have no mask, or use
+        one of the suggestions above. */
+      need_clipping = 0;
+    }
+
+  if (need_clipping)
+    {
+      GdkRectangle clip_box;
+
+      clip_box.x = clip_x;
+      clip_box.y = clip_y;
+      clip_box.width = clip_width;
+      clip_box.height = clip_height;
+
+      gdk_gc_set_clip_rectangle (gc, &clip_box);
+      gdk_gc_set_clip_origin (gc, x, y);
+    }
+
+  if (IMAGE_INSTANCE_PIXMAP_DEPTH (p) > 0)
+    {
+      gdk_draw_pixmap (GDK_DRAWABLE (x_win), gc,
+                      IMAGE_INSTANCE_GTK_PIXMAP (p),
+                      0, pixmap_offset, x, y, width, height);
+    }
+  else
+    {
+      our_draw_bitmap (GDK_DRAWABLE (x_win), gc,
+                      IMAGE_INSTANCE_GTK_PIXMAP (p),
+                      0, pixmap_offset, x, y, width, height);
+    }
+
+  if (need_clipping)
+  {
+      gdk_gc_set_clip_rectangle (gc, NULL);
+      gdk_gc_set_clip_origin (gc, 0, 0);
+  }
+}
+
+static void
+gtk_output_pixmap (struct window *w, struct display_line *dl,
+                  Lisp_Object image_instance, int xpos, int xoffset,
+                  int start_pixpos, int width, face_index findex,
+                  int cursor_start, int cursor_width, int cursor_height)
+{
+  struct frame *f = XFRAME (w->frame);
+  struct device *d = XDEVICE (f->device);
+  struct Lisp_Image_Instance *p = XIMAGE_INSTANCE (image_instance);
+  Lisp_Object window;
+
+  GdkWindow *x_win = GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (f));
+  int lheight = dl->ascent + dl->descent - dl->clip;
+  int pheight = ((int) IMAGE_INSTANCE_PIXMAP_HEIGHT (p) > lheight ? lheight :
+                IMAGE_INSTANCE_PIXMAP_HEIGHT (p));
+  int pwidth = min (width + xoffset, (int) IMAGE_INSTANCE_PIXMAP_WIDTH (p));
+  int clip_x, clip_y, clip_width, clip_height;
+
+  /* The pixmap_offset is used to center the pixmap on lines which are
+     shorter than it is.  This results in odd effects when scrolling
+     pixmaps off of the bottom.  Let's try not using it. */
+#if 0
+  int pixmap_offset = (int) (IMAGE_INSTANCE_PIXMAP_HEIGHT (p) - lheight) / 2;
+#else
+  int pixmap_offset = 0;
+#endif
+
+  XSETWINDOW (window, w);
+
+  if ((start_pixpos >= 0 && start_pixpos > xpos) || xoffset)
+    {
+      if (start_pixpos > xpos && start_pixpos > xpos + width)
+       return;
+
+      clip_x = xoffset;
+      clip_width = width;
+      if (start_pixpos > xpos)
+       {
+         clip_x += (start_pixpos - xpos);
+         clip_width -= (start_pixpos - xpos);
+       }
+    }
+  else
+    {
+      clip_x = 0;
+      clip_width = 0;
+    }
+
+  /* Place markers for possible future functionality (clipping the top
+     half instead of the bottom half; think pixel scrolling). */
+  clip_y = 0;
+  clip_height = pheight;
+
+  /* Clear the area the pixmap is going into.  The pixmap itself will
+     always take care of the full width.  We don't want to clear where
+     it is going to go in order to avoid flicker.  So, all we have to
+     take care of is any area above or below the pixmap. */
+  /* #### We take a shortcut for now.  We know that since we have
+     pixmap_offset hardwired to 0 that the pixmap is against the top
+     edge so all we have to worry about is below it. */
+  /* #### Unless the pixmap has a mask in which case we have to clear
+     the whole damn thing since we can't yet clear just the area not
+     included in the mask. */
+  if (((int) (dl->ypos - dl->ascent + pheight) <
+       (int) (dl->ypos + dl->descent - dl->clip))
+      || IMAGE_INSTANCE_GTK_MASK (p))
+    {
+      int clear_x, clear_y, clear_width, clear_height;
+
+      if (IMAGE_INSTANCE_GTK_MASK (p))
+       {
+         clear_y = dl->ypos - dl->ascent;
+         clear_height = lheight;
+       }
+      else
+       {
+         clear_y = dl->ypos - dl->ascent + pheight;
+         clear_height = lheight - pheight;
+       }
+
+      if (start_pixpos >= 0 && start_pixpos > xpos)
+       {
+         clear_x = start_pixpos;
+         clear_width = xpos + width - start_pixpos;
+       }
+      else
+       {
+         clear_x = xpos;
+         clear_width = width;
+       }
+
+      redisplay_clear_region (window, findex, clear_x, clear_y,
+                             clear_width, clear_height);
+    }
+
+  /* Output the pixmap. */
+  {
+    Lisp_Object tmp_pixel;
+    GdkColor *tmp_bcolor, *tmp_fcolor;
+
+    tmp_pixel = WINDOW_FACE_CACHEL_FOREGROUND (w, findex);
+    tmp_fcolor = COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (tmp_pixel));
+    tmp_pixel = WINDOW_FACE_CACHEL_BACKGROUND (w, findex);
+    tmp_bcolor = COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (tmp_pixel));
+
+    gtk_output_gdk_pixmap (f, p, xpos - xoffset, dl->ypos - dl->ascent, clip_x,
+                          clip_y, clip_width, clip_height,
+                          pwidth, pheight, pixmap_offset,
+                          tmp_fcolor, tmp_bcolor, 0);
+  }
+
+  /* Draw a cursor over top of the pixmap. */
+  if (cursor_width && cursor_height && (cursor_start >= xpos)
+      && !NILP (w->text_cursor_visible_p)
+      && (cursor_start < xpos + pwidth))
+    {
+      GdkGC *gc;
+      int focus = EQ (w->frame, DEVICE_FRAME_WITH_FOCUS_REAL (d));
+      int y = dl->ypos - dl->ascent;
+      struct face_cachel *cursor_cachel =
+       WINDOW_FACE_CACHEL (w,
+                           get_builtin_face_cache_index
+                           (w, Vtext_cursor_face));
+
+      gc = gtk_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, Qnil);
+
+      if (cursor_width > xpos + pwidth - cursor_start)
+       cursor_width = xpos + pwidth - cursor_start;
+
+      gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc, focus ? TRUE : FALSE,
+                         cursor_start, y, cursor_width,
+                         cursor_height);
+    }
+}
+
+/*****************************************************************************
+ gtk_output_vertical_divider
+
+ Draw a vertical divider down the right side of the given window.
+ ****************************************************************************/
+static void
+gtk_output_vertical_divider (struct window *w, int clear)
+{
+  struct frame *f = XFRAME (w->frame);
+  struct device *d = XDEVICE (f->device);
+  GdkWindow *x_win = GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (f));
+  GdkGC *background_gc;
+  Lisp_Object tmp_pixel;
+  GdkGCValues gcv;
+  unsigned long mask;
+  int x, y1, y2, width, shadow_thickness, spacing, line_width;
+  face_index div_face = get_builtin_face_cache_index (w, Vvertical_divider_face);
+  
+  width = window_divider_width (w);
+  shadow_thickness = XINT (w->vertical_divider_shadow_thickness);
+  spacing = XINT (w->vertical_divider_spacing);
+  line_width = XINT (w->vertical_divider_line_width);
+  x = WINDOW_RIGHT (w) - width;
+  y1 = WINDOW_TOP (w);
+  y2 = WINDOW_BOTTOM (w);
+  
+  memset (&gcv, ~0, sizeof (gcv));
+  
+  tmp_pixel = WINDOW_FACE_CACHEL_BACKGROUND (w, div_face);
+  
+  gcv.background = * COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (tmp_pixel));
+  gcv.foreground = gcv.background;
+  gcv.graphics_exposures = FALSE;
+  mask = GDK_GC_FOREGROUND | GDK_GC_BACKGROUND | GDK_GC_EXPOSURES;
+
+  background_gc = gc_cache_lookup (DEVICE_GTK_GC_CACHE (d), &gcv, mask);
+
+  /* Clear the divider area first.  This needs to be done when a
+     window split occurs. */
+  /* if (clear) */
+  gdk_draw_rectangle (GDK_DRAWABLE (x_win), background_gc, TRUE,
+                     x, y1, width, y2 - y1);
+
+#if 0
+  /* Draw the divider line. */
+  gdk_draw_rectangle (GDK_DRAWABLE (x_win), background_gc, TRUE,
+                     x + spacing + shadow_thickness, y1,
+                     line_width, y2 - y1);
+#endif
+  
+  /* Draw the shadows around the divider line */
+  gtk_output_shadows (f, x + spacing, y1, 
+                     width - 2 * spacing, y2 - y1,
+                     shadow_thickness);
+}
+
+/*****************************************************************************
+ gtk_output_blank
+
+ Output a blank by clearing the area it covers in the foreground color
+ of its face.
+ ****************************************************************************/
+static void
+gtk_output_blank (struct window *w, struct display_line *dl, struct rune *rb,
+                 int start_pixpos, int cursor_start, int cursor_width)
+{
+  struct frame *f = XFRAME (w->frame);
+  struct device *d = XDEVICE (f->device);
+
+  GdkWindow *x_win = GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (f));
+  GdkGC *gc;
+  struct face_cachel *cursor_cachel =
+    WINDOW_FACE_CACHEL (w,
+                       get_builtin_face_cache_index
+                       (w, Vtext_cursor_face));
+  Lisp_Object bg_pmap;
+  Lisp_Object buffer = WINDOW_BUFFER (w);
+  Lisp_Object bar_cursor_value = symbol_value_in_buffer (Qbar_cursor,
+                                                        buffer);
+
+  int x = rb->xpos;
+  int y = dl->ypos - dl->ascent;
+  int width = rb->width;
+  int height = dl->ascent + dl->descent - dl->clip;
+
+  if (start_pixpos > x)
+    {
+      if (start_pixpos >= (x + width))
+       return;
+      else
+       {
+         width -= (start_pixpos - x);
+         x = start_pixpos;
+       }
+    }
+
+  bg_pmap = WINDOW_FACE_CACHEL_BACKGROUND_PIXMAP (w, rb->findex);
+  if (!IMAGE_INSTANCEP (bg_pmap)
+      || !IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pmap)))
+    bg_pmap = Qnil;
+
+  if (NILP (bg_pmap))
+    gc = gtk_get_gc (d, Qnil, WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex),
+                    Qnil, Qnil, Qnil);
+  else
+    gc = gtk_get_gc (d, Qnil, WINDOW_FACE_CACHEL_FOREGROUND (w, rb->findex),
+                    WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex), bg_pmap,
+                    Qnil);
+
+  gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc, TRUE, x, y, width, height);
+
+  /* If this rune is marked as having the cursor, then it is actually
+     representing a tab. */
+  if (!NILP (w->text_cursor_visible_p)
+      && (rb->cursor_type == CURSOR_ON
+         || (cursor_width
+             && (cursor_start + cursor_width > x)
+             && cursor_start < (x + width))))
+    {
+      int cursor_height, cursor_y;
+      int focus = EQ (w->frame, DEVICE_FRAME_WITH_FOCUS_REAL (d));
+      struct Lisp_Font_Instance *fi;
+
+      fi = XFONT_INSTANCE (FACE_CACHEL_FONT
+                          (WINDOW_FACE_CACHEL (w, rb->findex),
+                           Vcharset_ascii));
+
+      gc = gtk_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, Qnil);
+
+      cursor_y = dl->ypos - fi->ascent;
+      cursor_height = fi->height;
+      if (cursor_y + cursor_height > y + height)
+       cursor_height = y + height - cursor_y;
+
+      if (focus)
+       {
+         if (NILP (bar_cursor_value))
+           {
+               gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc, TRUE,
+                                   cursor_start, cursor_y,
+                                   fi->width, cursor_height);
+           }
+         else
+           {
+             int bar_width = EQ (bar_cursor_value, Qt) ? 1 : 2;
+
+             gc = gtk_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil,
+                              make_int (bar_width));
+             gdk_draw_line (GDK_DRAWABLE (x_win), gc, cursor_start + bar_width - 1,
+                            cursor_y, cursor_start + bar_width - 1,
+                            cursor_y + cursor_height - 1);
+           }
+       }
+      else if (NILP (bar_cursor_value))
+       {
+           gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc, FALSE,
+                               cursor_start, cursor_y,
+                               fi->width - 1, cursor_height - 1);
+       }
+    }
+}
+
+/*****************************************************************************
+ gtk_output_hline
+
+ Output a horizontal line in the foreground of its face.
+ ****************************************************************************/
+static void
+gtk_output_hline (struct window *w, struct display_line *dl, struct rune *rb)
+{
+  struct frame *f = XFRAME (w->frame);
+  struct device *d = XDEVICE (f->device);
+  GtkStyle *style = FRAME_GTK_TEXT_WIDGET (f)->style;
+
+  GdkWindow *x_win = GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (f));
+  GdkGC *gc;
+
+  int x = rb->xpos;
+  int width = rb->width;
+  int height = dl->ascent + dl->descent - dl->clip;
+
+  int ypos1, ypos2, ypos3, ypos4;
+
+  ypos1 = dl->ypos - dl->ascent;
+  ypos2 = ypos1 + rb->object.hline.yoffset;
+  ypos3 = ypos2 + rb->object.hline.thickness;
+  ypos4 = dl->ypos + dl->descent - dl->clip;
+
+  /* First clear the area not covered by the line. */
+  if (height - rb->object.hline.thickness > 0)
+    {
+      gc = gtk_get_gc (d, Qnil, WINDOW_FACE_CACHEL_FOREGROUND (w, rb->findex),
+                    Qnil, Qnil, Qnil);
+
+      if (ypos2 - ypos1 > 0)
+         gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc, TRUE, x, ypos1, width, ypos2 - ypos1);
+      if (ypos4 - ypos3 > 0)
+         gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc, TRUE, x, ypos1, width, ypos2 - ypos1);
+    }
+
+  gtk_paint_hline (style, x_win, GTK_STATE_NORMAL, NULL, FRAME_GTK_TEXT_WIDGET (f),
+                  "hline", x, x + width, ypos2);
+#if 0
+  /* Now draw the line. */
+  gc = gtk_get_gc (d, Qnil, WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex),
+                  Qnil, Qnil, Qnil);
+
+  if (ypos2 < ypos1)
+    ypos2 = ypos1;
+  if (ypos3 > ypos4)
+    ypos3 = ypos4;
+
+  if (ypos3 - ypos2 > 0)
+      gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc, TRUE, x, ypos2, width, ypos3 - ypos2);
+#endif
+}
+
+/*****************************************************************************
+ gtk_output_shadows
+
+ Draw a shadow around the given area using the standard theme engine routines.
+ ****************************************************************************/
+void
+gtk_output_shadows (struct frame *f, int x, int y, int width, int height,
+                   int shadow_thickness)
+{
+  GdkWindow *x_win = GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (f));
+  GtkStyle *style = FRAME_GTK_TEXT_WIDGET (f)->style;
+  GtkShadowType stype = GTK_SHADOW_OUT;
+
+  if (shadow_thickness < 0)
+  {
+      stype = GTK_SHADOW_IN;
+  }
+  else if (shadow_thickness == 0)
+  {
+      stype = GTK_SHADOW_NONE;
+  }
+
+  /* Do we want to have some magic constants to set
+     GTK_SHADOW_ETCHED_IN or GTK_SHADOW_ETCHED_OUT? */
+
+  gtk_paint_shadow (style, x_win, GTK_STATE_NORMAL, stype, NULL,
+                   FRAME_GTK_TEXT_WIDGET (f), "modeline",
+                   x, y, width, height);
+}
+
+/*****************************************************************************
+ gtk_clear_to_window_end
+
+ Clear the area between ypos1 and ypos2.  Each margin area and the
+ text area is handled separately since they may each have their own
+ background color.
+ ****************************************************************************/
+static void
+gtk_clear_to_window_end (struct window *w, int ypos1, int ypos2)
+{
+  int height = ypos2 - ypos1;
+
+  if (height)
+    {
+      struct frame *f = XFRAME (w->frame);
+      Lisp_Object window;
+      int bflag = (window_needs_vertical_divider (w) ? 0 : 1);
+      layout_bounds bounds;
+
+      bounds = calculate_display_line_boundaries (w, bflag);
+      XSETWINDOW (window, w);
+
+      if (window_is_leftmost (w))
+       redisplay_clear_region (window, DEFAULT_INDEX, FRAME_LEFT_BORDER_START (f),
+                               ypos1, FRAME_BORDER_WIDTH (f), height);
+
+      if (bounds.left_in - bounds.left_out > 0)
+       redisplay_clear_region (window,
+                               get_builtin_face_cache_index (w, Vleft_margin_face),
+                               bounds.left_out, ypos1,
+                               bounds.left_in - bounds.left_out, height);
+
+      if (bounds.right_in - bounds.left_in > 0)
+       redisplay_clear_region (window, DEFAULT_INDEX, bounds.left_in, ypos1,
+                               bounds.right_in - bounds.left_in, height);
+
+      if (bounds.right_out - bounds.right_in > 0)
+       redisplay_clear_region (window,
+                               get_builtin_face_cache_index (w, Vright_margin_face),
+                               bounds.right_in, ypos1,
+                               bounds.right_out - bounds.right_in, height);
+
+      if (window_is_rightmost (w))
+       redisplay_clear_region (window, DEFAULT_INDEX, FRAME_RIGHT_BORDER_START (f),
+                               ypos1, FRAME_BORDER_WIDTH (f), height);
+    }
+}
+
+/*****************************************************************************
+ gtk_redraw_exposed_window
+
+ Given a bounding box for an area that needs to be redrawn, determine
+ what parts of what lines are contained within and re-output their
+ contents.
+ ****************************************************************************/
+static void
+gtk_redraw_exposed_window (struct window *w, int x, int y, int width, int height)
+{
+  struct frame *f = XFRAME (w->frame);
+  int line;
+  int start_x, start_y, end_x, end_y;
+  int orig_windows_structure_changed;
+
+  display_line_dynarr *cdla = window_display_lines (w, CURRENT_DISP);
+
+  if (!NILP (w->vchild))
+    {
+      gtk_redraw_exposed_windows (w->vchild, x, y, width, height);
+      return;
+    }
+  else if (!NILP (w->hchild))
+    {
+      gtk_redraw_exposed_windows (w->hchild, x, y, width, height);
+      return;
+    }
+
+  /* If the window doesn't intersect the exposed region, we're done here. */
+  if (x >= WINDOW_RIGHT (w) || (x + width) <= WINDOW_LEFT (w)
+      || y >= WINDOW_BOTTOM (w) || (y + height) <= WINDOW_TOP (w))
+    {
+      return;
+    }
+  else
+    {
+      start_x = max (WINDOW_LEFT (w), x);
+      end_x = min (WINDOW_RIGHT (w), (x + width));
+      start_y = max (WINDOW_TOP (w), y);
+      end_y = min (WINDOW_BOTTOM (w), y + height);
+
+      /* We do this to make sure that the 3D modelines get redrawn if
+         they are in the exposed region. */
+      orig_windows_structure_changed = f->windows_structure_changed;
+      f->windows_structure_changed = 1;
+    }
+
+  if (window_needs_vertical_divider (w))
+    {
+      gtk_output_vertical_divider (w, 0);
+    }
+
+  for (line = 0; line < Dynarr_length (cdla); line++)
+    {
+      struct display_line *cdl = Dynarr_atp (cdla, line);
+      int top_y = cdl->ypos - cdl->ascent;
+      int bottom_y = cdl->ypos + cdl->descent;
+
+      if (bottom_y >= start_y)
+       {
+         if (top_y > end_y)
+           {
+             if (line == 0)
+               continue;
+             else
+               break;
+           }
+         else
+           {
+             output_display_line (w, 0, cdla, line, start_x, end_x);
+           }
+       }
+    }
+
+  f->windows_structure_changed = orig_windows_structure_changed;
+
+  /* If there have never been any face cache_elements created, then this
+     expose event doesn't actually have anything to do. */
+  if (Dynarr_largest (w->face_cachels))
+    redisplay_clear_bottom_of_window (w, cdla, start_y, end_y);
+}
+
+/*****************************************************************************
+ gtk_redraw_exposed_windows
+
+ For each window beneath the given window in the window hierarchy,
+ ensure that it is redrawn if necessary after an Expose event.
+ ****************************************************************************/
+static void
+gtk_redraw_exposed_windows (Lisp_Object window, int x, int y, int width,
+                           int height)
+{
+  for (; !NILP (window); window = XWINDOW (window)->next)
+    gtk_redraw_exposed_window (XWINDOW (window), x, y, width, height);
+}
+
+/*****************************************************************************
+ gtk_redraw_exposed_area
+
+ For each window on the given frame, ensure that any area in the
+ Exposed area is redrawn.
+ ****************************************************************************/
+void
+gtk_redraw_exposed_area (struct frame *f, int x, int y, int width, int height)
+{
+  /* If any window on the frame has had its face cache reset then the
+     redisplay structures are effectively invalid.  If we attempt to
+     use them we'll blow up.  We mark the frame as changed to ensure
+     that redisplay will do a full update.  This probably isn't
+     necessary but it can't hurt. */
+
+#ifdef HAVE_TOOLBARS
+  /* #### We would rather put these off as well but there is currently
+     no combination of flags which will force an unchanged toolbar to
+     redraw anyhow. */
+  MAYBE_FRAMEMETH (f, redraw_exposed_toolbars, (f, x, y, width, height));
+#endif
+  redraw_exposed_gutters (f, x, y, width, height);
+
+  if (!f->window_face_cache_reset)
+    {
+      gtk_redraw_exposed_windows (f->root_window, x, y, width, height);
+    }
+  else
+    MARK_FRAME_CHANGED (f);
+}
+
+/****************************************************************************
+ gtk_clear_region
+
+ Clear the area in the box defined by the given parameters using the
+ given face.
+ ****************************************************************************/
+static void
+gtk_clear_region (Lisp_Object locale, struct device* d, struct frame* f, face_index findex,
+                 int x, int y,
+                 int width, int height, Lisp_Object fcolor, Lisp_Object bcolor,
+                 Lisp_Object background_pixmap)
+{
+  GdkWindow *x_win;
+  GdkGC *gc = NULL;
+
+  x_win = GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (f));
+
+  if (!UNBOUNDP (background_pixmap))
+    {
+      gc = gtk_get_gc (d, Qnil, fcolor, bcolor, background_pixmap, Qnil);
+    }
+
+  if (gc)
+    {
+      gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc,TRUE,
+                         x, y, width, height);
+    }
+  else
+    {
+      gdk_window_clear_area (x_win, x, y, width, height);
+    }
+}
+
+/*****************************************************************************
+ gtk_output_eol_cursor
+
+ Draw a cursor at the end of a line.  The end-of-line cursor is
+ narrower than the normal cursor.
+ ****************************************************************************/
+static void
+gtk_output_eol_cursor (struct window *w, struct display_line *dl, int xpos,
+                      face_index findex)
+{
+  struct frame *f = XFRAME (w->frame);
+  struct device *d = XDEVICE (f->device);
+  Lisp_Object window;
+
+  GdkWindow *x_win = GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (f));
+  GdkGC *gc;
+  face_index elt = get_builtin_face_cache_index (w, Vtext_cursor_face);
+  struct face_cachel *cursor_cachel = WINDOW_FACE_CACHEL (w, elt);
+
+  int focus = EQ (w->frame, DEVICE_FRAME_WITH_FOCUS_REAL (d));
+  Lisp_Object bar_cursor_value = symbol_value_in_buffer (Qbar_cursor,
+                                                        WINDOW_BUFFER (w));
+
+  int x = xpos;
+  int y = dl->ypos - dl->ascent;
+  int width = EOL_CURSOR_WIDTH;
+  int height = dl->ascent + dl->descent - dl->clip;
+  int cursor_height, cursor_y;
+  int defheight, defascent;
+
+  XSETWINDOW (window, w);
+  redisplay_clear_region (window, findex, x, y, width, height);
+
+  if (NILP (w->text_cursor_visible_p))
+    return;
+
+  gc = gtk_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, Qnil);
+
+  default_face_font_info (window, &defascent, 0, &defheight, 0, 0);
+
+  /* make sure the cursor is entirely contained between y and y+height */
+  cursor_height = min (defheight, height);
+  cursor_y = max (y, min (y + height - cursor_height,
+                         dl->ypos - defascent));
+
+  if (focus)
+    {
+      if (NILP (bar_cursor_value))
+       {
+           gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc, TRUE, x, cursor_y, width, cursor_height);
+       }
+      else
+       {
+         int bar_width = EQ (bar_cursor_value, Qt) ? 1 : 2;
+
+         gc = gtk_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil,
+                          make_int (bar_width));
+         gdk_draw_line (GDK_DRAWABLE (x_win), gc, x + bar_width - 1, cursor_y,
+                        x + bar_width - 1, cursor_y + cursor_height - 1);
+       }
+    }
+  else if (NILP (bar_cursor_value))
+    {
+       gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc, FALSE, x, cursor_y, width - 1,
+                           cursor_height - 1);
+    }
+}
+
+static void
+gtk_clear_frame_window (Lisp_Object window)
+{
+  struct window *w = XWINDOW (window);
+
+  if (!NILP (w->vchild))
+    {
+      gtk_clear_frame_windows (w->vchild);
+      return;
+    }
+
+  if (!NILP (w->hchild))
+    {
+      gtk_clear_frame_windows (w->hchild);
+      return;
+    }
+
+  gtk_clear_to_window_end (w, WINDOW_TEXT_TOP (w), WINDOW_TEXT_BOTTOM (w));
+}
+
+static void
+gtk_clear_frame_windows (Lisp_Object window)
+{
+  for (; !NILP (window); window = XWINDOW (window)->next)
+    gtk_clear_frame_window (window);
+}
+
+static void
+gtk_clear_frame (struct frame *f)
+{
+  GdkWindow *x_win = GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (f));
+  int x, y, width, height;
+  Lisp_Object frame;
+
+  x = FRAME_LEFT_BORDER_START (f);
+  width = (FRAME_PIXWIDTH (f) - FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) -
+          FRAME_REAL_RIGHT_TOOLBAR_WIDTH (f) -
+          2 * FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f) -
+          2 * FRAME_REAL_RIGHT_TOOLBAR_BORDER_WIDTH (f));
+  /* #### This adjustment by 1 should be being done in the macros.
+     There is some small differences between when the menubar is on
+     and off that we still need to deal with. */
+  y = FRAME_TOP_BORDER_START (f) - 1;
+  height = (FRAME_PIXHEIGHT (f) - FRAME_REAL_TOP_TOOLBAR_HEIGHT (f) -
+           FRAME_REAL_BOTTOM_TOOLBAR_HEIGHT (f) -
+           2 * FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f) -
+           2 * FRAME_REAL_BOTTOM_TOOLBAR_BORDER_WIDTH (f)) + 1;
+
+  gdk_window_clear_area (x_win, x, y, width, height);
+
+  XSETFRAME (frame, f);
+
+  if (!UNBOUNDP (FACE_BACKGROUND_PIXMAP (Vdefault_face, frame))
+      || !UNBOUNDP (FACE_BACKGROUND_PIXMAP (Vleft_margin_face, frame))
+      || !UNBOUNDP (FACE_BACKGROUND_PIXMAP (Vright_margin_face, frame)))
+    {
+      gtk_clear_frame_windows (f->root_window);
+    }
+}
+
+static int
+gtk_flash (struct device *d)
+{
+  GdkGCValues gcv;
+  GdkGC *gc;
+  GdkColor tmp_fcolor, tmp_bcolor;
+  Lisp_Object tmp_pixel, frame;
+  struct frame *f = device_selected_frame (d);
+  struct window *w = XWINDOW (FRAME_ROOT_WINDOW (f));
+
+  XSETFRAME (frame, f);
+
+  tmp_pixel = FACE_FOREGROUND (Vdefault_face, frame);
+  tmp_fcolor = * (COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (tmp_pixel)));
+  tmp_pixel = FACE_BACKGROUND (Vdefault_face, frame);
+  tmp_bcolor = * (COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (tmp_pixel)));
+
+  memset (&gcv, ~0, sizeof (gcv)); /* initialize all slots to ~0 */
+  gcv.foreground.pixel  = (tmp_fcolor.pixel ^ tmp_bcolor.pixel);
+  gcv.function = GDK_XOR;
+  gcv.graphics_exposures = FALSE;
+  gc = gc_cache_lookup (DEVICE_GTK_GC_CACHE (XDEVICE (f->device)), &gcv,
+                       GDK_GC_FOREGROUND | GDK_GC_FUNCTION | GDK_GC_EXPOSURES);
+
+  gdk_draw_rectangle (GDK_DRAWABLE (GET_GTK_WIDGET_WINDOW (FRAME_GTK_SHELL_WIDGET (f))),
+                     gc, TRUE, w->pixel_left, w->pixel_top,
+                     w->pixel_width, w->pixel_height);
+
+  gdk_flush ();
+
+#ifdef HAVE_POLL
+  poll (0, 0, 100);
+#else /* !HAVE_POLL */
+#ifdef HAVE_SELECT
+  {
+    int usecs = 100000;
+    struct timeval tv;
+    tv.tv_sec  = usecs / 1000000L;
+    tv.tv_usec = usecs % 1000000L;
+    /* I'm sure someone is going to complain about this... */
+    select (0, 0, 0, 0, &tv);
+  }
+#else
+  bite me
+#endif /* HAVE_POLL */
+#endif /* HAVE_SELECT */
+
+  gdk_draw_rectangle (GDK_DRAWABLE (GET_GTK_WIDGET_WINDOW (FRAME_GTK_SHELL_WIDGET (f))),
+                     gc, TRUE, w->pixel_left, w->pixel_top,
+                     w->pixel_width, w->pixel_height);
+
+  gdk_flush ();
+
+  return 1;
+}
+
+static void
+gtk_bevel_area (struct window *w, face_index findex,
+               int x, int y, int width, int height,
+               int shadow_thickness, int edges, enum edge_style style)
+{
+  struct frame *f = XFRAME (w->frame);
+  struct device *d = XDEVICE (f->device);
+
+  gtk_output_shadows (f, x, y, width, height, shadow_thickness);
+}
+
+
+
+/* Make audible bell.  */
+static void
+gtk_ring_bell (struct device *d, int volume, int pitch, int duration)
+{
+       /* Gdk does not allow us to control the duration / pitch / volume */
+       gdk_beep ();
+}
+
+\f
+/************************************************************************/
+/*                            initialization                            */
+/************************************************************************/
+
+void
+console_type_create_redisplay_gtk (void)
+{
+  /* redisplay methods */
+  CONSOLE_HAS_METHOD (gtk, text_width);
+  CONSOLE_HAS_METHOD (gtk, output_display_block);
+  CONSOLE_HAS_METHOD (gtk, divider_height);
+  CONSOLE_HAS_METHOD (gtk, eol_cursor_width);
+  CONSOLE_HAS_METHOD (gtk, output_vertical_divider);
+  CONSOLE_HAS_METHOD (gtk, clear_to_window_end);
+  CONSOLE_HAS_METHOD (gtk, clear_region);
+  CONSOLE_HAS_METHOD (gtk, clear_frame);
+  CONSOLE_HAS_METHOD (gtk, flash);
+  CONSOLE_HAS_METHOD (gtk, ring_bell);
+  CONSOLE_HAS_METHOD (gtk, bevel_area);
+  CONSOLE_HAS_METHOD (gtk, output_string);
+  /*  CONSOLE_HAS_METHOD (gtk, output_pixmap); */
+}
+
+/* This makes me feel incredibly dirty... but there is no other way to
+   get this done right other than calling clear_area before every
+   single $#!%@ing piece of text, which I do NOT want to do. */
+#define USE_X_SPECIFIC_DRAW_ROUTINES 1
+
+#include <gdk/gdkx.h>
+
+void
+gdk_draw_text_image (GdkDrawable *drawable,
+                    GdkFont     *font,
+                    GdkGC       *gc,
+                    gint         x,
+                    gint         y,
+                    const gchar *text,
+                    gint         text_length)
+{
+#if !USE_X_SPECIFIC_DRAW_ROUTINES
+  int width = gdk_text_measure (font, text, text_length);
+  int height = gdk_text_height (font, text, text_length);
+
+  gdk_draw_rectangle (drawable, gc, TRUE, x, y, width, height);
+  gdk_draw_text (drawable, font, gc, x, y, text, text_length);
+#else
+  GdkWindowPrivate *drawable_private;
+  GdkFontPrivate *font_private;
+  GdkGCPrivate *gc_private;
+
+  g_return_if_fail (drawable != NULL);
+  g_return_if_fail (font != NULL);
+  g_return_if_fail (gc != NULL);
+  g_return_if_fail (text != NULL);
+
+  drawable_private = (GdkWindowPrivate*) drawable;
+  if (drawable_private->destroyed)
+    return;
+  gc_private = (GdkGCPrivate*) gc;
+  font_private = (GdkFontPrivate*) font;
+
+  if (font->type == GDK_FONT_FONT)
+    {
+      XFontStruct *xfont = (XFontStruct *) font_private->xfont;
+      XSetFont(drawable_private->xdisplay, gc_private->xgc, xfont->fid);
+      if ((xfont->min_byte1 == 0) && (xfont->max_byte1 == 0))
+       {
+         XDrawImageString (drawable_private->xdisplay, drawable_private->xwindow,
+                           gc_private->xgc, x, y, text, text_length);
+       }
+      else
+       {
+         XDrawImageString16 (drawable_private->xdisplay, drawable_private->xwindow,
+                             gc_private->xgc, x, y, (XChar2b *) text, text_length / 2);
+       }
+    }
+  else if (font->type == GDK_FONT_FONTSET)
+    {
+      XFontSet fontset = (XFontSet) font_private->xfont;
+      XmbDrawImageString (drawable_private->xdisplay, drawable_private->xwindow,
+                         fontset, gc_private->xgc, x, y, text, text_length);
+    }
+  else
+    g_error("undefined font type\n");
+#endif
+}
+
+static void
+our_draw_bitmap (GdkDrawable *drawable,
+                GdkGC       *gc,
+                GdkPixmap   *src,
+                gint         xsrc,
+                gint         ysrc,
+                gint         xdest,
+                gint         ydest,
+                gint         width,
+                gint         height)
+{
+  GdkWindowPrivate *drawable_private;
+  GdkWindowPrivate *src_private;
+  GdkGCPrivate *gc_private;
+
+  g_return_if_fail (drawable != NULL);
+  g_return_if_fail (src != NULL);
+  g_return_if_fail (gc != NULL);
+
+  drawable_private = (GdkWindowPrivate*) drawable;
+  src_private = (GdkWindowPrivate*) src;
+  if (drawable_private->destroyed || src_private->destroyed)
+    return;
+  gc_private = (GdkGCPrivate*) gc;
+
+  if (width == -1)
+    width = src_private->width;
+  if (height == -1)
+    height = src_private->height;
+
+  XCopyPlane (drawable_private->xdisplay,
+            src_private->xwindow,
+            drawable_private->xwindow,
+            gc_private->xgc,
+            xsrc, ysrc,
+            width, height,
+            xdest, ydest, 1L);
+}

diff --git a/src/scrollbar-gtk.c b/src/scrollbar-gtk.c
new file mode 100644 (file)
index 0000000..c7247ff
--- /dev/null
+++ b/src/scrollbar-gtk.c
@@ -0,0 +1,481 @@
+/* scrollbar implementation -- X interface.
+   Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
+   Copyright (C) 1994 Amdhal Corporation.
+   Copyright (C) 1995 Sun Microsystems, Inc.
+   Copyright (C) 1995 Darrell Kindred <dkindred+@cmu.edu>.
+
+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, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with: Not in FSF. */
+/* Gtk version by William M. Perry */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "console-gtk.h"
+#include "glyphs-gtk.h"
+#include "gui-gtk.h"
+#include "scrollbar-gtk.h"
+
+#include "frame.h"
+#include "window.h"
+
+static gboolean scrollbar_cb (GtkAdjustment *adj, gpointer user_data);
+
+/* Used to prevent changing the size of the slider while drag
+   scrolling, under Motif.  This is necessary because the Motif
+   scrollbar is incredibly stupid about updating the slider and causes
+   lots of flicker if it is done too often.  */
+static int inhibit_slider_size_change;
+
+static int vertical_drag_in_progress;
+
+\f
+/* A device method. */
+static int
+gtk_inhibit_scrollbar_slider_size_change (void)
+{
+  return inhibit_slider_size_change;
+}
+
+/* A device method. */
+static void
+gtk_free_scrollbar_instance (struct scrollbar_instance *instance)
+{
+  if (SCROLLBAR_GTK_WIDGET (instance))
+    {
+      gtk_widget_hide_all (SCROLLBAR_GTK_WIDGET (instance));
+      gtk_widget_destroy (SCROLLBAR_GTK_WIDGET (instance));
+    }
+
+  if (instance->scrollbar_data)
+    xfree (instance->scrollbar_data);
+}
+
+/* A device method. */
+static void
+gtk_release_scrollbar_instance (struct scrollbar_instance *instance)
+{
+    /* It won't hurt to hide it all the time, will it? */
+    gtk_widget_hide_all (SCROLLBAR_GTK_WIDGET (instance));
+}
+
+static gboolean
+scrollbar_drag_hack_cb (GtkWidget *w, GdkEventButton *ev, gpointer v)
+{
+  vertical_drag_in_progress = (int) v;
+  inhibit_slider_size_change = (int) v;
+  return (FALSE);
+}
+
+/* A device method. */
+static void
+gtk_create_scrollbar_instance (struct frame *f, int vertical,
+                              struct scrollbar_instance *instance)
+{
+  GtkAdjustment *adj = GTK_ADJUSTMENT (gtk_adjustment_new (0,0,0,0,0,0));
+  GtkScrollbar *sb = NULL;
+
+  /* initialize the X specific data section. */
+  instance->scrollbar_data = xnew_and_zero (struct gtk_scrollbar_data);
+
+  SCROLLBAR_GTK_ID (instance) = new_gui_id ();
+  SCROLLBAR_GTK_VDRAG_ORIG_VALUE (instance) = -1;
+  SCROLLBAR_GTK_LAST_VALUE (instance) = adj->value;
+
+  gtk_object_set_data (GTK_OBJECT (adj), "xemacs::gui_id", (void *) SCROLLBAR_GTK_ID (instance));
+  gtk_object_set_data (GTK_OBJECT (adj), "xemacs::frame", f);
+  gtk_object_set_data (GTK_OBJECT (adj), "xemacs::sb_instance", instance);
+
+  sb = GTK_SCROLLBAR (vertical ? gtk_vscrollbar_new (adj) : gtk_hscrollbar_new (adj));
+  SCROLLBAR_GTK_WIDGET (instance) = GTK_WIDGET (sb);
+
+  gtk_signal_connect (GTK_OBJECT (adj),"value-changed",
+                     GTK_SIGNAL_FUNC (scrollbar_cb), (gpointer) vertical);
+
+  gtk_signal_connect (GTK_OBJECT (sb), "button-press-event",
+                     GTK_SIGNAL_FUNC (scrollbar_drag_hack_cb), (gpointer) 1);
+  gtk_signal_connect (GTK_OBJECT (sb), "button-release-event",
+                     GTK_SIGNAL_FUNC (scrollbar_drag_hack_cb), (gpointer) 0);
+
+  gtk_fixed_put (GTK_FIXED (FRAME_GTK_TEXT_WIDGET (f)), SCROLLBAR_GTK_WIDGET (instance), 0, 0);
+  gtk_widget_hide (SCROLLBAR_GTK_WIDGET (instance));
+}
+
+#define UPDATE_DATA_FIELD(field)                               \
+  if (new_##field >= 0 &&                                      \
+      SCROLLBAR_GTK_POS_DATA (inst).field != new_##field) {    \
+    SCROLLBAR_GTK_POS_DATA (inst).field = new_##field;         \
+    inst->scrollbar_instance_changed = 1;                      \
+  }
+
+/* A device method. */
+/* #### The -1 check is such a hack. */
+static void
+gtk_update_scrollbar_instance_values (struct window *w,
+                                     struct scrollbar_instance *inst,
+                                     int new_line_increment,
+                                     int new_page_increment,
+                                     int new_minimum, int new_maximum,
+                                     int new_slider_size,
+                                     int new_slider_position,
+                                     int new_scrollbar_width,
+                                     int new_scrollbar_height,
+                                     int new_scrollbar_x, int new_scrollbar_y)
+{
+  UPDATE_DATA_FIELD (line_increment);
+  UPDATE_DATA_FIELD (page_increment);
+  UPDATE_DATA_FIELD (minimum);
+  UPDATE_DATA_FIELD (maximum);
+  UPDATE_DATA_FIELD (slider_size);
+  UPDATE_DATA_FIELD (slider_position);
+  UPDATE_DATA_FIELD (scrollbar_width);
+  UPDATE_DATA_FIELD (scrollbar_height);
+  UPDATE_DATA_FIELD (scrollbar_x);
+  UPDATE_DATA_FIELD (scrollbar_y);
+
+  if (w && !vertical_drag_in_progress)
+    {
+      int new_vov = SCROLLBAR_GTK_POS_DATA (inst).slider_position;
+      int new_vows = marker_position (w->start[CURRENT_DISP]);
+
+      if (SCROLLBAR_GTK_VDRAG_ORIG_VALUE (inst) != new_vov)
+       {
+         SCROLLBAR_GTK_VDRAG_ORIG_VALUE (inst) = new_vov;
+         inst->scrollbar_instance_changed = 1;
+       }
+      if (SCROLLBAR_GTK_VDRAG_ORIG_WINDOW_START (inst) != new_vows)
+       {
+         SCROLLBAR_GTK_VDRAG_ORIG_WINDOW_START (inst) = new_vows;
+         inst->scrollbar_instance_changed = 1;
+       }
+    }
+}
+
+/* Used by gtk_update_scrollbar_instance_status. */
+static void
+update_one_widget_scrollbar_pointer (struct window *w, GtkWidget *wid)
+{
+  if (!wid->window)
+    gtk_widget_realize (wid);
+
+  if (POINTER_IMAGE_INSTANCEP (w->scrollbar_pointer))
+    {
+      gdk_window_set_cursor (GET_GTK_WIDGET_WINDOW (wid),
+                            XIMAGE_INSTANCE_GTK_CURSOR (w->scrollbar_pointer));
+      gdk_flush ();
+    }
+}
+
+/* A device method. */
+static void
+gtk_update_scrollbar_instance_status (struct window *w, int active, int size,
+                                     struct scrollbar_instance *instance)
+{
+  struct frame *f = XFRAME (w->frame);
+  GtkWidget *wid = SCROLLBAR_GTK_WIDGET (instance);
+  gboolean managed = GTK_WIDGET_MAPPED (wid);
+
+  if (active && size)
+    {
+      if (instance->scrollbar_instance_changed)
+       {
+         /* Need to set the height, width, and position of the widget */
+         GtkAdjustment *adj = gtk_range_get_adjustment (GTK_RANGE (wid));
+         scrollbar_values *pos_data = & SCROLLBAR_GTK_POS_DATA (instance);
+         int modified_p = 0;
+
+         /* We do not want to update the size all the time if we can
+             help it.  This cuts down on annoying flicker.
+         */
+         if ((wid->allocation.width != pos_data->scrollbar_width) ||
+             (wid->allocation.height != pos_data->scrollbar_height))
+           {
+             gtk_widget_set_usize (wid,
+                                   pos_data->scrollbar_width,
+                                   pos_data->scrollbar_height);
+             modified_p = 1;
+           }
+
+         /* Ditto for the x/y position. */
+         if ((wid->allocation.x != pos_data->scrollbar_x) ||
+             (wid->allocation.y != pos_data->scrollbar_y))
+           {
+             gtk_fixed_move (GTK_FIXED (FRAME_GTK_TEXT_WIDGET (f)),
+                             wid,
+                             pos_data->scrollbar_x,
+                             pos_data->scrollbar_y);
+             modified_p = 1;
+           }
+
+         adj->lower = pos_data->minimum;
+         adj->upper = pos_data->maximum;
+         adj->page_increment = pos_data->slider_size + 1;
+         adj->step_increment = w->max_line_len - 1;
+         adj->page_size = pos_data->slider_size + 1;
+         adj->value = pos_data->slider_position;
+
+         /* But, if we didn't resize or move the scrollbar, the
+             widget will not get redrawn correctly when the user
+             scrolls around in the XEmacs frame manually.  So we
+             update the slider manually here.
+         */
+         if (!modified_p)
+           gtk_range_slider_update (GTK_RANGE (wid));
+
+         instance->scrollbar_instance_changed = 0;
+       }
+
+      if (!managed)
+       {
+         gtk_widget_show (wid);
+         update_one_widget_scrollbar_pointer (w, wid);
+       }
+    }
+  else if (managed)
+    {
+      gtk_widget_hide (wid);
+    }
+}
+
+enum gtk_scrollbar_loop
+{
+  GTK_FIND_SCROLLBAR_WINDOW_MIRROR,
+  GTK_SET_SCROLLBAR_POINTER,
+  GTK_WINDOW_IS_SCROLLBAR,
+  GTK_UPDATE_FRAME_SCROLLBARS
+};
+
+static struct window_mirror *
+gtk_scrollbar_loop (enum gtk_scrollbar_loop type, Lisp_Object window,
+                   struct window_mirror *mir,
+                   GUI_ID id, GdkWindow *x_win)
+{
+  struct window_mirror *retval = NULL;
+
+  while (mir)
+    {
+      struct scrollbar_instance *vinstance = mir->scrollbar_vertical_instance;
+      struct scrollbar_instance *hinstance = mir->scrollbar_horizontal_instance;
+      struct window *w = XWINDOW (window);
+
+      if (mir->vchild)
+       retval = gtk_scrollbar_loop (type, w->vchild, mir->vchild, id, x_win);
+      else if (mir->hchild)
+       retval = gtk_scrollbar_loop (type, w->hchild, mir->hchild, id, x_win);
+      if (retval)
+       return retval;
+
+      if (hinstance || vinstance)
+       {
+         switch (type)
+           {
+           case GTK_FIND_SCROLLBAR_WINDOW_MIRROR:
+             if ((vinstance && SCROLLBAR_GTK_ID (vinstance) == id) ||
+                 (hinstance && SCROLLBAR_GTK_ID (hinstance) == id))
+               return mir;
+             break;
+           case GTK_UPDATE_FRAME_SCROLLBARS:
+             if (!mir->vchild && !mir->hchild)
+               update_window_scrollbars (w, mir, 1, 0);
+             break;
+           case GTK_SET_SCROLLBAR_POINTER:
+             if (!mir->vchild && !mir->hchild)
+               {
+                  GtkWidget *widget;
+
+                 widget = SCROLLBAR_GTK_WIDGET (hinstance);
+                 if (widget && GTK_WIDGET_MAPPED (widget))
+                   update_one_widget_scrollbar_pointer (w, widget);
+
+                 widget = SCROLLBAR_GTK_WIDGET (vinstance);
+                 if (widget && GTK_WIDGET_MAPPED (widget))
+                   update_one_widget_scrollbar_pointer (w, widget);
+               }
+             break;
+           case GTK_WINDOW_IS_SCROLLBAR:
+             if (!mir->vchild && !mir->hchild)
+               {
+                 GtkWidget *widget;
+
+                 widget = SCROLLBAR_GTK_WIDGET (hinstance);
+                 if (widget && GTK_WIDGET_MAPPED (widget) &&
+                     GET_GTK_WIDGET_WINDOW (widget) == x_win)
+                   return (struct window_mirror *) 1;
+
+                 widget = SCROLLBAR_GTK_WIDGET (vinstance);
+                 if (widget && GTK_WIDGET_MAPPED (widget) &&
+                     GET_GTK_WIDGET_WINDOW (widget) == x_win)
+                   return (struct window_mirror *) 1;
+               }
+             break;
+           default:
+             abort ();
+           }
+       }
+
+      mir = mir->next;
+      window = w->next;
+    }
+
+  return NULL;
+}
+
+/* Used by callbacks. */
+static struct window_mirror *
+find_scrollbar_window_mirror (struct frame *f, GUI_ID id)
+{
+  if (f->mirror_dirty)
+    update_frame_window_mirror (f);
+  return gtk_scrollbar_loop (GTK_FIND_SCROLLBAR_WINDOW_MIRROR, f->root_window,
+                            f->root_mirror, id, (GdkWindow *) NULL);
+}
+
+static gboolean
+scrollbar_cb (GtkAdjustment *adj, gpointer user_data)
+{
+  /* This function can GC */
+  int vertical = (int) user_data;
+  struct frame *f = gtk_object_get_data (GTK_OBJECT (adj), "xemacs::frame");
+  struct scrollbar_instance *instance = gtk_object_get_data (GTK_OBJECT (adj), "xemacs::sb_instance");
+  GUI_ID id = (GUI_ID) gtk_object_get_data (GTK_OBJECT (adj), "xemacs::gui_id");
+  Lisp_Object win, frame;
+  struct window_mirror *mirror;
+  Lisp_Object event_type = Qnil;
+  Lisp_Object event_data = Qnil;
+
+  if (!f)
+    return(FALSE);
+
+  mirror = find_scrollbar_window_mirror (f, id);
+  if (!mirror)
+    return(FALSE);
+  
+  win = real_window (mirror, 1);
+
+  if (NILP (win))
+    return(FALSE);
+  instance = vertical ? mirror->scrollbar_vertical_instance : mirror->scrollbar_horizontal_instance;
+  frame = WINDOW_FRAME (XWINDOW (win));
+
+  inhibit_slider_size_change = 0;
+  switch (GTK_RANGE (SCROLLBAR_GTK_WIDGET (instance))->scroll_type)
+    {
+    case GTK_SCROLL_PAGE_BACKWARD:
+      event_type = vertical ? Qscrollbar_page_up : Qscrollbar_page_left;
+      event_data = Fcons (win, Qnil);
+      break;
+    case GTK_SCROLL_PAGE_FORWARD:
+      event_type = vertical ? Qscrollbar_page_down : Qscrollbar_page_right;
+      event_data = Fcons (win, Qnil);
+      break;
+    case GTK_SCROLL_STEP_FORWARD:
+      event_type = vertical ? Qscrollbar_line_down : Qscrollbar_char_right;
+      event_data = win;
+      break;
+    case GTK_SCROLL_STEP_BACKWARD:
+      event_type = vertical ? Qscrollbar_line_up : Qscrollbar_char_left;
+      event_data = win;
+      break;
+    case GTK_SCROLL_NONE:
+    case GTK_SCROLL_JUMP:
+      inhibit_slider_size_change = 1;
+      event_type = vertical ? Qscrollbar_vertical_drag : Qscrollbar_horizontal_drag;
+      event_data = Fcons (win, make_int ((int)adj->value));
+      break;
+    default:
+      abort();
+    }
+
+  signal_special_gtk_user_event (frame, event_type, event_data);
+
+  return (TRUE);
+}
+
+static void
+gtk_scrollbar_pointer_changed_in_window (struct window *w)
+{
+  Lisp_Object window;
+
+  XSETWINDOW (window, w);
+  gtk_scrollbar_loop (GTK_SET_SCROLLBAR_POINTER, window, find_window_mirror (w),
+                     0, (GdkWindow *) NULL);
+}
+
+/* #### BILL!!! This comment is not true for Gtk - should it be? */
+/* Make sure that all scrollbars on frame are up-to-date.  Called
+   directly from gtk_set_frame_properties in frame-gtk.c*/
+void
+gtk_update_frame_scrollbars (struct frame *f)
+{
+  /* Consider this code to be "in_display" so that we abort() if Fsignal()
+     gets called. */
+  in_display++;
+  gtk_scrollbar_loop (GTK_UPDATE_FRAME_SCROLLBARS, f->root_window, f->root_mirror,
+                     0, (GdkWindow *) NULL);
+  in_display--;
+  if (in_display < 0) abort ();
+}
+
+#ifdef MEMORY_USAGE_STATS
+static int
+gtk_compute_scrollbar_instance_usage (struct device *d,
+                                     struct scrollbar_instance *inst,
+                                     struct overhead_stats *ovstats)
+{
+  int total = 0;
+
+  while (inst)
+    {
+      struct gtk_scrollbar_data *data =
+       (struct gtk_scrollbar_data *) inst->scrollbar_data;
+
+      total += malloced_storage_size (data, sizeof (*data), ovstats);
+      inst = inst->next;
+    }
+
+  return total;
+}
+
+#endif /* MEMORY_USAGE_STATS */
+
+
+/************************************************************************/
+/*                            initialization                            */
+/************************************************************************/
+
+void
+console_type_create_scrollbar_gtk (void)
+{
+  CONSOLE_HAS_METHOD (gtk, inhibit_scrollbar_slider_size_change);
+  CONSOLE_HAS_METHOD (gtk, free_scrollbar_instance);
+  CONSOLE_HAS_METHOD (gtk, release_scrollbar_instance);
+  CONSOLE_HAS_METHOD (gtk, create_scrollbar_instance);
+  CONSOLE_HAS_METHOD (gtk, update_scrollbar_instance_values);
+  CONSOLE_HAS_METHOD (gtk, update_scrollbar_instance_status);
+  CONSOLE_HAS_METHOD (gtk, scrollbar_pointer_changed_in_window);
+#ifdef MEMORY_USAGE_STATS
+  CONSOLE_HAS_METHOD (gtk, compute_scrollbar_instance_usage);
+#endif /* MEMORY_USAGE_STATS */
+}
+
+void
+vars_of_scrollbar_gtk (void)
+{
+  Fprovide (intern ("gtk-scrollbars"));
+}

diff --git a/src/scrollbar-gtk.h b/src/scrollbar-gtk.h
new file mode 100644 (file)
index 0000000..98be12c
--- /dev/null
+++ b/src/scrollbar-gtk.h
@@ -0,0 +1,84 @@
+/* Define Gtk-specific scrollbar instance.
+   Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
+
+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, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with: Not in FSF. */
+
+#ifndef _XEMACS_SCROLLBAR_GTK_H_
+#define _XEMACS_SCROLLBAR_GTK_H_
+
+#if defined (HAVE_GTK) && defined (HAVE_SCROLLBARS)
+
+#include "scrollbar.h"
+
+typedef struct _scrollbar_values
+{
+  int line_increment;
+  int page_increment;
+
+  int minimum;
+  int maximum;
+
+  int slider_size;
+  int slider_position;
+
+  int scrollbar_width, scrollbar_height;
+  int scrollbar_x, scrollbar_y;
+} scrollbar_values;
+
+struct gtk_scrollbar_data
+{
+  /* Unique scrollbar identifier and name. */
+  unsigned int id;
+
+  /* Is set if we have already set the backing_store attribute correctly */
+  char backing_store_initialized;
+
+  /* Positioning and sizing information for scrollbar and slider. */
+  scrollbar_values pos_data;
+
+  /* Pointer to the scrollbar widget this structure describes. */
+  GtkWidget *widget;
+
+  gfloat last_value;
+
+  /* Recorded starting position for Motif-like scrollbar drags. */
+  int vdrag_orig_value;
+  Bufpos vdrag_orig_window_start;
+};
+
+#define SCROLLBAR_GTK_DATA(i) ((struct gtk_scrollbar_data *) ((i)->scrollbar_data))
+
+#define SCROLLBAR_GTK_ID(i) (SCROLLBAR_GTK_DATA (i)->id)
+#define SCROLLBAR_GTK_BACKING_STORE_INITIALIZED(i) \
+  (SCROLLBAR_GTK_DATA (i)->backing_store_initialized)
+#define SCROLLBAR_GTK_POS_DATA(i) (SCROLLBAR_GTK_DATA (i)->pos_data)
+#define SCROLLBAR_GTK_WIDGET(i) (SCROLLBAR_GTK_DATA (i)->widget)
+#define SCROLLBAR_GTK_LAST_VALUE(i) SCROLLBAR_GTK_DATA (i)->last_value
+
+#define SCROLLBAR_GTK_VDRAG_ORIG_VALUE(i) \
+  (SCROLLBAR_GTK_DATA (i)->vdrag_orig_value)
+#define SCROLLBAR_GTK_VDRAG_ORIG_WINDOW_START(i) \
+  (SCROLLBAR_GTK_DATA (i)->vdrag_orig_window_start)
+
+void gtk_update_frame_scrollbars (struct frame *f);
+void gtk_set_scrollbar_pointer (struct frame *f, Lisp_Object cursor);
+
+#endif /* HAVE_GDK and HAVE_SCROLLBARS */
+#endif /* _XEMACS_SCROLLBAR_GTK_H_ */

diff --git a/src/select-gtk.c b/src/select-gtk.c
new file mode 100644 (file)
index 0000000..a11cb63
--- /dev/null
+++ b/src/select-gtk.c
@@ -0,0 +1,946 @@
+/* GTK selection processing for XEmacs
+   Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
+
+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, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with: Not synched with FSF. */
+
+/* Authorship:
+
+   Written by Kevin Gallo for FSF Emacs.
+   Rewritten for mswindows by Jonathan Harris, December 1997 for 21.0.
+   Rewritten for GTK by William Perry, April 2000 for 21.1
+ */
+
+
+#include <config.h>
+#include "lisp.h"
+#include "events.h"
+#include "buffer.h"
+#include "device.h"
+#include "console-gtk.h"
+#include "select.h"
+#include "opaque.h"
+#include "frame.h"
+
+static Lisp_Object Vretrieved_selection;
+static gboolean waiting_for_selection;
+Lisp_Object Vgtk_sent_selection_hooks;
+
+static Lisp_Object atom_to_symbol (struct device *d, GdkAtom atom);
+static GdkAtom symbol_to_gtk_atom (struct device *d, Lisp_Object sym, int only_if_exists);
+
+static void lisp_data_to_selection_data (struct device *,
+                                        Lisp_Object obj,
+                                        unsigned char **data_ret,
+                                        GdkAtom *type_ret,
+                                        unsigned int *size_ret,
+                                        int *format_ret);
+static Lisp_Object selection_data_to_lisp_data (struct device *,
+                                               Extbyte *data,
+                                               size_t size,
+                                               GdkAtom type,
+                                               int format);
+
+/* Set the selection data to GDK_NONE and NULL data, meaning we were
+** unable to do what they wanted.
+*/
+static void
+gtk_decline_selection_request (GtkSelectionData *data)
+{
+  gtk_selection_data_set (data, GDK_NONE, 0, NULL, 0);
+}
+
+/* Used as an unwind-protect clause so that, if a selection-converter signals
+   an error, we tell the requestor that we were unable to do what they wanted
+   before we throw to top-level or go into the debugger or whatever.
+ */
+struct _selection_closure
+{
+  GtkSelectionData *data;
+  gboolean successful;
+};
+
+static Lisp_Object
+gtk_selection_request_lisp_error (Lisp_Object closure)
+{
+  struct _selection_closure *cl = (struct _selection_closure *)
+    get_opaque_ptr (closure);
+
+  free_opaque_ptr (closure);
+  if (cl->successful == TRUE)
+    return Qnil;
+  gtk_decline_selection_request (cl->data);
+  return Qnil;
+}
+
+/* This provides the current selection to a requester.
+**
+** This is connected to the selection_get() signal of the application
+** shell in device-gtk.c:gtk_init_device().
+**
+** This is radically different than the old selection code (21.1.x),
+** but has been modeled after the X code, and appears to work.
+**
+** WMP Feb 12 2001
+*/
+void
+emacs_gtk_selection_handle (GtkWidget *widget,
+                           GtkSelectionData *selection_data,
+                           guint info,
+                           guint time_stamp,
+                           gpointer data)
+{
+  /* This function can GC */
+  struct gcpro gcpro1, gcpro2;
+  Lisp_Object temp_obj;
+  Lisp_Object selection_symbol;
+  Lisp_Object target_symbol = Qnil;
+  Lisp_Object converted_selection = Qnil;
+  guint32 local_selection_time;
+  Lisp_Object successful_p = Qnil;
+  int count;
+  struct device *d = decode_gtk_device (Qnil);
+  struct _selection_closure *cl = NULL;
+
+  GCPRO2 (converted_selection, target_symbol);
+
+  selection_symbol = atom_to_symbol (d, selection_data->selection);
+  target_symbol = atom_to_symbol (d, selection_data->target);
+
+#if 0 /* #### MULTIPLE doesn't work yet */
+  if (EQ (target_symbol, QMULTIPLE))
+    target_symbol = fetch_multiple_target (selection_data);
+#endif
+
+  temp_obj = Fget_selection_timestamp (selection_symbol);
+
+  if (NILP (temp_obj))
+    {
+      /* We don't appear to have the selection. */
+      gtk_decline_selection_request (selection_data);
+
+      goto DONE_LABEL;
+    }
+
+  local_selection_time = * (guint32 *) XOPAQUE_DATA (temp_obj);
+
+  if (time_stamp != GDK_CURRENT_TIME &&
+      local_selection_time > time_stamp)
+    {
+      /* Someone asked for the selection, and we have one, but not the one
+        they're looking for. */
+      gtk_decline_selection_request (selection_data);
+      goto DONE_LABEL;
+    }
+
+  converted_selection = select_convert_out (selection_symbol,
+                                           target_symbol, Qnil);
+
+  /* #### Is this the right thing to do? I'm no X expert. -- ajh */
+  if (NILP (converted_selection))
+    {
+      /* We don't appear to have a selection in that data type. */
+      gtk_decline_selection_request (selection_data);
+      goto DONE_LABEL;
+    }
+
+  count = specpdl_depth ();
+
+  cl = (struct _selection_closure *) xmalloc (sizeof (*cl));
+  cl->data = selection_data;
+  cl->successful = FALSE;
+
+  record_unwind_protect (gtk_selection_request_lisp_error,
+                        make_opaque_ptr (cl));
+
+  {
+    unsigned char *data;
+    unsigned int size;
+    int format;
+    GdkAtom type;
+    lisp_data_to_selection_data (d, converted_selection,
+                                &data, &type, &size, &format);
+
+    gtk_selection_data_set (selection_data, type, format, data, size);
+    successful_p = Qt;
+    /* Tell x_selection_request_lisp_error() it's cool. */
+    cl->successful = TRUE;
+    xfree (data);
+  }
+
+  unbind_to (count, Qnil);
+
+ DONE_LABEL:
+
+  if (cl) xfree (cl);
+
+  UNGCPRO;
+
+  /* Let random lisp code notice that the selection has been asked for. */
+  {
+    Lisp_Object val = Vgtk_sent_selection_hooks;
+    if (!UNBOUNDP (val) && !NILP (val))
+      {
+       Lisp_Object rest;
+       if (CONSP (val) && !EQ (XCAR (val), Qlambda))
+         for (rest = val; !NILP (rest); rest = Fcdr (rest))
+           call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
+       else
+         call3 (val, selection_symbol, target_symbol, successful_p);
+      }
+  }
+}
+
+
+\f
+static GtkWidget *reading_selection_reply;
+static GdkAtom reading_which_selection;
+static int selection_reply_timed_out;
+
+/* Gets the current selection owned by another application */
+void
+emacs_gtk_selection_received (GtkWidget *widget,
+                             GtkSelectionData *selection_data,
+                             gpointer user_data)
+{
+  waiting_for_selection = FALSE;
+  Vretrieved_selection = Qnil;
+
+  reading_selection_reply = NULL;
+
+  signal_fake_event ();
+
+  if (selection_data->length < 0)
+    {
+      return;
+    }
+
+  Vretrieved_selection =
+    selection_data_to_lisp_data (NULL,
+                                selection_data->data,
+                                selection_data->length,
+                                selection_data->type,
+                                selection_data->format);
+}
+
+static int
+selection_reply_done (void *ignore)
+{
+  return !reading_selection_reply;
+}
+
+/* Do protocol to read selection-data from the server.
+   Converts this to lisp data and returns it.
+ */
+static Lisp_Object
+gtk_get_foreign_selection (Lisp_Object selection_symbol,
+                          Lisp_Object target_type)
+{
+  /* This function can GC */
+  struct device *d = decode_gtk_device (Qnil);
+  GtkWidget *requestor = DEVICE_GTK_APP_SHELL (d);
+  guint32 requestor_time = DEVICE_GTK_MOUSE_TIMESTAMP (d);
+  GdkAtom selection_atom = symbol_to_gtk_atom (d, selection_symbol, 0);
+  int speccount;
+  GdkAtom type_atom = symbol_to_gtk_atom (d, (CONSP (target_type) ?
+                                             XCAR (target_type) : target_type), 0);
+
+  gtk_selection_convert (requestor, selection_atom, type_atom,
+                        requestor_time);
+
+  signal_fake_event ();
+
+  /* Block until the reply has been read. */
+  reading_selection_reply = requestor;
+  reading_which_selection = selection_atom;
+  selection_reply_timed_out = 0;
+
+  speccount = specpdl_depth ();
+
+#if 0
+  /* add a timeout handler */
+  if (gtk_selection_timeout > 0)
+    {
+      Lisp_Object id = Fadd_timeout (make_int (x_selection_timeout),
+                                    Qx_selection_reply_timeout_internal,
+                                    Qnil, Qnil);
+      record_unwind_protect (Fdisable_timeout, id);
+    }
+#endif
+
+  /* This is ^Gable */
+  wait_delaying_user_input (selection_reply_done, 0);
+
+  if (selection_reply_timed_out)
+    error ("timed out waiting for reply from selection owner");
+
+  unbind_to (speccount, Qnil);
+
+  /* otherwise, the selection is waiting for us on the requested property. */
+  return select_convert_in (selection_symbol,
+                           target_type,
+                           Vretrieved_selection);
+}
+
+
+#if 0
+static void
+gtk_get_window_property (struct device *d, GtkWidget *window, GdkAtom property,
+                        Extbyte **data_ret, int *bytes_ret,
+                        GdkAtom *actual_type_ret, int *actual_format_ret,
+                        unsigned long *actual_size_ret, int delete_p)
+{
+  size_t total_size;
+  unsigned long bytes_remaining;
+  int offset = 0;
+  unsigned char *tmp_data = 0;
+  int result;
+  int buffer_size = SELECTION_QUANTUM (display);
+  if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM;
+
+  /* First probe the thing to find out how big it is. */
+  result = XGetWindowProperty (display, window, property,
+                              0, 0, False, AnyPropertyType,
+                              actual_type_ret, actual_format_ret,
+                              actual_size_ret,
+                              &bytes_remaining, &tmp_data);
+  if (result != Success)
+    {
+      *data_ret = 0;
+      *bytes_ret = 0;
+      return;
+    }
+  XFree ((char *) tmp_data);
+
+  if (*actual_type_ret == None || *actual_format_ret == 0)
+    {
+      if (delete_p) XDeleteProperty (display, window, property);
+      *data_ret = 0;
+      *bytes_ret = 0;
+      return;
+    }
+
+  total_size = bytes_remaining + 1;
+  *data_ret = (Extbyte *) xmalloc (total_size);
+
+  /* Now read, until we've gotten it all. */
+  while (bytes_remaining)
+    {
+#if 0
+      int last = bytes_remaining;
+#endif
+      result =
+       XGetWindowProperty (display, window, property,
+                           offset/4, buffer_size/4,
+                           (delete_p ? True : False),
+                           AnyPropertyType,
+                           actual_type_ret, actual_format_ret,
+                           actual_size_ret, &bytes_remaining, &tmp_data);
+#if 0
+      stderr_out ("<< read %d\n", last-bytes_remaining);
+#endif
+      /* If this doesn't return Success at this point, it means that
+        some clod deleted the selection while we were in the midst of
+        reading it.  Deal with that, I guess....
+       */
+      if (result != Success) break;
+      *actual_size_ret *= *actual_format_ret / 8;
+      memcpy ((*data_ret) + offset, tmp_data, *actual_size_ret);
+      offset += *actual_size_ret;
+      XFree ((char *) tmp_data);
+    }
+  *bytes_ret = offset;
+}
+
+
+static void
+receive_incremental_selection (Display *display, Window window, Atom property,
+                              /* this one is for error messages only */
+                              Lisp_Object target_type,
+                              unsigned int min_size_bytes,
+                              Extbyte **data_ret, int *size_bytes_ret,
+                              Atom *type_ret, int *format_ret,
+                              unsigned long *size_ret)
+{
+  /* This function can GC */
+  int offset = 0;
+  int prop_id;
+  *size_bytes_ret = min_size_bytes;
+  *data_ret = (Extbyte *) xmalloc (*size_bytes_ret);
+#if 0
+  stderr_out ("\nread INCR %d\n", min_size_bytes);
+#endif
+  /* At this point, we have read an INCR property, and deleted it (which
+     is how we ack its receipt: the sending window will be selecting
+     PropertyNotify events on our window to notice this).
+
+     Now, we must loop, waiting for the sending window to put a value on
+     that property, then reading the property, then deleting it to ack.
+     We are done when the sender places a property of length 0.
+   */
+  prop_id = expect_property_change (display, window, property,
+                                   PropertyNewValue);
+  while (1)
+    {
+      Extbyte *tmp_data;
+      int tmp_size_bytes;
+      wait_for_property_change (prop_id);
+      /* expect it again immediately, because x_get_window_property may
+        .. no it won't, I don't get it.
+        .. Ok, I get it now, the Xt code that implements INCR is broken.
+       */
+      prop_id = expect_property_change (display, window, property,
+                                       PropertyNewValue);
+      x_get_window_property (display, window, property,
+                            &tmp_data, &tmp_size_bytes,
+                            type_ret, format_ret, size_ret, 1);
+
+      if (tmp_size_bytes == 0) /* we're done */
+       {
+#if 0
+         stderr_out ("  read INCR done\n");
+#endif
+         unexpect_property_change (prop_id);
+         if (tmp_data) xfree (tmp_data);
+         break;
+       }
+#if 0
+      stderr_out ("  read INCR %d\n", tmp_size_bytes);
+#endif
+      if (*size_bytes_ret < offset + tmp_size_bytes)
+       {
+#if 0
+         stderr_out ("  read INCR realloc %d -> %d\n",
+                  *size_bytes_ret, offset + tmp_size_bytes);
+#endif
+         *size_bytes_ret = offset + tmp_size_bytes;
+         *data_ret = (Extbyte *) xrealloc (*data_ret, *size_bytes_ret);
+       }
+      memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes);
+      offset += tmp_size_bytes;
+      xfree (tmp_data);
+    }
+}
+
+
+static Lisp_Object
+gtk_get_window_property_as_lisp_data (struct device *d,
+                                     GtkWidget *window,
+                                     GdkAtom property,
+                                     /* next two for error messages only */
+                                     Lisp_Object target_type,
+                                     GdkAtom selection_atom)
+{
+  /* This function can GC */
+  Atom actual_type;
+  int actual_format;
+  unsigned long actual_size;
+  Extbyte *data = NULL;
+  int bytes = 0;
+  Lisp_Object val;
+  struct device *d = get_device_from_display (display);
+
+  x_get_window_property (display, window, property, &data, &bytes,
+                        &actual_type, &actual_format, &actual_size, 1);
+  if (! data)
+    {
+      if (XGetSelectionOwner (display, selection_atom))
+       /* there is a selection owner */
+       signal_error
+         (Qselection_conversion_error,
+          Fcons (build_string ("selection owner couldn't convert"),
+                 Fcons (x_atom_to_symbol (d, selection_atom),
+                        actual_type ?
+                        list2 (target_type, x_atom_to_symbol (d, actual_type)) :
+                        list1 (target_type))));
+      else
+       signal_error (Qerror,
+                     list2 (build_string ("no selection"),
+                            x_atom_to_symbol (d, selection_atom)));
+    }
+
+  if (actual_type == DEVICE_XATOM_INCR (d))
+    {
+      /* Ok, that data wasn't *the* data, it was just the beginning. */
+
+      unsigned int min_size_bytes = * ((unsigned int *) data);
+      xfree (data);
+      receive_incremental_selection (display, window, property, target_type,
+                                    min_size_bytes, &data, &bytes,
+                                    &actual_type, &actual_format,
+                                    &actual_size);
+    }
+
+  /* It's been read.  Now convert it to a lisp object in some semi-rational
+     manner. */
+  val = selection_data_to_lisp_data (d, data, bytes,
+                                    actual_type, actual_format);
+
+  xfree (data);
+  return val;
+}
+#endif
+
+\f
+static GdkAtom
+symbol_to_gtk_atom (struct device *d, Lisp_Object sym, int only_if_exists)
+{
+  if (NILP (sym))              return GDK_SELECTION_PRIMARY;
+  if (EQ (sym, Qt))            return GDK_SELECTION_SECONDARY;
+  if (EQ (sym, QPRIMARY))      return GDK_SELECTION_PRIMARY;
+  if (EQ (sym, QSECONDARY))    return GDK_SELECTION_SECONDARY;
+
+  {
+    const char *nameext;
+    LISP_STRING_TO_EXTERNAL (Fsymbol_name (sym), nameext, Qctext);
+    return gdk_atom_intern (nameext, only_if_exists ? TRUE : FALSE);
+  }
+}
+
+static Lisp_Object
+atom_to_symbol (struct device *d, GdkAtom atom)
+{
+  if (atom == GDK_SELECTION_PRIMARY) return (QPRIMARY);
+  if (atom == GDK_SELECTION_SECONDARY) return (QSECONDARY);
+
+  {
+    char *intstr;
+    char *str = gdk_atom_name (atom);
+
+    if (! str) return Qnil;
+
+    TO_INTERNAL_FORMAT (C_STRING, str,
+                       C_STRING_ALLOCA, intstr,
+                       Qctext);
+    g_free (str);
+    return intern (intstr);
+  }
+}
+
+/* #### These are going to move into Lisp code(!) with the aid of
+        some new functions I'm working on - ajh */
+
+/* These functions convert from the selection data read from the server into
+   something that we can use from elisp, and vice versa.
+
+       Type:   Format: Size:           Elisp Type:
+       -----   ------- -----           -----------
+       *       8       *               String
+       ATOM    32      1               Symbol
+       ATOM    32      > 1             Vector of Symbols
+       *       16      1               Integer
+       *       16      > 1             Vector of Integers
+       *       32      1               if <=16 bits: Integer
+                                       if > 16 bits: Cons of top16, bot16
+       *       32      > 1             Vector of the above
+
+   When converting a Lisp number to C, it is assumed to be of format 16 if
+   it is an integer, and of format 32 if it is a cons of two integers.
+
+   When converting a vector of numbers from Elisp to C, it is assumed to be
+   of format 16 if every element in the vector is an integer, and is assumed
+   to be of format 32 if any element is a cons of two integers.
+
+   When converting an object to C, it may be of the form (SYMBOL . <data>)
+   where SYMBOL is what we should claim that the type is.  Format and
+   representation are as above.
+
+   NOTE: Under Mule, when someone shoves us a string without a type, we
+   set the type to 'COMPOUND_TEXT and automatically convert to Compound
+   Text.  If the string has a type, we assume that the user wants the
+   data sent as-is so we just do "binary" conversion.
+ */
+
+
+static Lisp_Object
+selection_data_to_lisp_data (struct device *d,
+                            Extbyte *data,
+                            size_t size,
+                            GdkAtom type,
+                            int format)
+{
+  if (type == gdk_atom_intern ("NULL", 0))
+    return QNULL;
+
+  /* Convert any 8-bit data to a string, for compactness. */
+  else if (format == 8)
+    return make_ext_string (data, size,
+                           ((type == gdk_atom_intern ("TEXT", FALSE)) ||
+                            (type == gdk_atom_intern ("COMPOUND_TEXT", FALSE)))
+                           ? Qctext : Qbinary);
+
+  /* Convert a single atom to a Lisp Symbol.
+     Convert a set of atoms to a vector of symbols. */
+  else if (type == gdk_atom_intern ("ATOM", FALSE))
+    {
+      if (size == sizeof (GdkAtom))
+       return atom_to_symbol (d, *((GdkAtom *) data));
+      else
+       {
+         int i;
+         int len = size / sizeof (GdkAtom);
+         Lisp_Object v = Fmake_vector (make_int (len), Qzero);
+         for (i = 0; i < len; i++)
+           Faset (v, make_int (i), atom_to_symbol (d, ((GdkAtom *) data) [i]));
+         return v;
+       }
+    }
+
+  /* Convert a single 16 or small 32 bit number to a Lisp Int.
+     If the number is > 16 bits, convert it to a cons of integers,
+     16 bits in each half.
+   */
+  else if (format == 32 && size == sizeof (long))
+    return word_to_lisp (((unsigned long *) data) [0]);
+  else if (format == 16 && size == sizeof (short))
+    return make_int ((int) (((unsigned short *) data) [0]));
+
+  /* Convert any other kind of data to a vector of numbers, represented
+     as above (as an integer, or a cons of two 16 bit integers).
+
+     #### Perhaps we should return the actual type to lisp as well.
+
+       (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
+       ==> [4 4]
+
+     and perhaps it should be
+
+       (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
+       ==> (SPAN . [4 4])
+
+     Right now the fact that the return type was SPAN is discarded before
+     lisp code gets to see it.
+   */
+  else if (format == 16)
+    {
+      int i;
+      Lisp_Object v = make_vector (size / 4, Qzero);
+      for (i = 0; i < (int) size / 4; i++)
+       {
+         int j = (int) ((unsigned short *) data) [i];
+         Faset (v, make_int (i), make_int (j));
+       }
+      return v;
+    }
+  else
+    {
+      int i;
+      Lisp_Object v = make_vector (size / 4, Qzero);
+      for (i = 0; i < (int) size / 4; i++)
+       {
+         unsigned long j = ((unsigned long *) data) [i];
+         Faset (v, make_int (i), word_to_lisp (j));
+       }
+      return v;
+    }
+}
+
+
+static void
+lisp_data_to_selection_data (struct device *d,
+                            Lisp_Object obj,
+                            unsigned char **data_ret,
+                            GdkAtom *type_ret,
+                            unsigned int *size_ret,
+                            int *format_ret)
+{
+  Lisp_Object type = Qnil;
+
+  if (CONSP (obj) && SYMBOLP (XCAR (obj)))
+    {
+      type = XCAR (obj);
+      obj = XCDR (obj);
+      if (CONSP (obj) && NILP (XCDR (obj)))
+       obj = XCAR (obj);
+    }
+
+  if (EQ (obj, QNULL) || (EQ (type, QNULL)))
+    {                          /* This is not the same as declining */
+      *format_ret = 32;
+      *size_ret = 0;
+      *data_ret = 0;
+      type = QNULL;
+    }
+  else if (STRINGP (obj))
+    {
+      const Extbyte *extval;
+      Extcount extvallen;
+
+      TO_EXTERNAL_FORMAT (LISP_STRING, obj,
+                         ALLOCA, (extval, extvallen),
+                         (NILP (type) ? Qctext : Qbinary));
+      *format_ret = 8;
+      *size_ret = extvallen;
+      *data_ret = (unsigned char *) xmalloc (*size_ret);
+      memcpy (*data_ret, extval, *size_ret);
+#ifdef MULE
+      if (NILP (type)) type = QCOMPOUND_TEXT;
+#else
+      if (NILP (type)) type = QSTRING;
+#endif
+    }
+  else if (CHARP (obj))
+    {
+      Bufbyte buf[MAX_EMCHAR_LEN];
+      Bytecount len;
+      const Extbyte *extval;
+      Extcount extvallen;
+
+      *format_ret = 8;
+      len = set_charptr_emchar (buf, XCHAR (obj));
+      TO_EXTERNAL_FORMAT (DATA, (buf, len),
+                         ALLOCA, (extval, extvallen),
+                         Qctext);
+      *size_ret = extvallen;
+      *data_ret = (unsigned char *) xmalloc (*size_ret);
+      memcpy (*data_ret, extval, *size_ret);
+#ifdef MULE
+      if (NILP (type)) type = QCOMPOUND_TEXT;
+#else
+      if (NILP (type)) type = QSTRING;
+#endif
+    }
+  else if (SYMBOLP (obj))
+    {
+      *format_ret = 32;
+      *size_ret = 1;
+      *data_ret = (unsigned char *) xmalloc (sizeof (GdkAtom) + 1);
+      (*data_ret) [sizeof (GdkAtom)] = 0;
+      (*(GdkAtom **) data_ret) [0] = symbol_to_gtk_atom (d, obj, 0);
+      if (NILP (type)) type = QATOM;
+    }
+  else if (INTP (obj) &&
+          XINT (obj) <= 0x7FFF &&
+          XINT (obj) >= -0x8000)
+    {
+      *format_ret = 16;
+      *size_ret = 1;
+      *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
+      (*data_ret) [sizeof (short)] = 0;
+      (*(short **) data_ret) [0] = (short) XINT (obj);
+      if (NILP (type)) type = QINTEGER;
+    }
+  else if (INTP (obj) || CONSP (obj))
+    {
+      *format_ret = 32;
+      *size_ret = 1;
+      *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
+      (*data_ret) [sizeof (long)] = 0;
+      (*(unsigned long **) data_ret) [0] = lisp_to_word (obj);
+      if (NILP (type)) type = QINTEGER;
+    }
+  else if (VECTORP (obj))
+    {
+      /* Lisp Vectors may represent a set of ATOMs;
+        a set of 16 or 32 bit INTEGERs;
+        or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
+       */
+      int i;
+
+      if (SYMBOLP (XVECTOR_DATA (obj) [0]))
+       /* This vector is an ATOM set */
+       {
+         if (NILP (type)) type = QATOM;
+         *size_ret = XVECTOR_LENGTH (obj);
+         *format_ret = 32;
+         *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (GdkAtom));
+         for (i = 0; i < (int) (*size_ret); i++)
+           if (SYMBOLP (XVECTOR_DATA (obj) [i]))
+             (*(GdkAtom **) data_ret) [i] =
+               symbol_to_gtk_atom (d, XVECTOR_DATA (obj) [i], 0);
+           else
+              signal_error (Qerror, /* Qselection_error */
+                            list2 (build_string
+                  ("all elements of the vector must be of the same type"),
+                                   obj));
+       }
+#if 0 /* #### MULTIPLE doesn't work yet */
+      else if (VECTORP (XVECTOR_DATA (obj) [0]))
+       /* This vector is an ATOM_PAIR set */
+       {
+         if (NILP (type)) type = QATOM_PAIR;
+         *size_ret = XVECTOR_LENGTH (obj);
+         *format_ret = 32;
+         *data_ret = (unsigned char *)
+           xmalloc ((*size_ret) * sizeof (Atom) * 2);
+         for (i = 0; i < *size_ret; i++)
+           if (VECTORP (XVECTOR_DATA (obj) [i]))
+             {
+               Lisp_Object pair = XVECTOR_DATA (obj) [i];
+               if (XVECTOR_LENGTH (pair) != 2)
+                 signal_error (Qerror,
+                                list2 (build_string
+       ("elements of the vector must be vectors of exactly two elements"),
+                                 pair));
+
+               (*(GdkAtom **) data_ret) [i * 2] =
+                 symbol_to_gtk_atom (d, XVECTOR_DATA (pair) [0], 0);
+               (*(GdkAtom **) data_ret) [(i * 2) + 1] =
+                 symbol_to_gtk_atom (d, XVECTOR_DATA (pair) [1], 0);
+             }
+           else
+             signal_error (Qerror,
+                            list2 (build_string
+                  ("all elements of the vector must be of the same type"),
+                                   obj));
+       }
+#endif
+      else
+       /* This vector is an INTEGER set, or something like it */
+       {
+         *size_ret = XVECTOR_LENGTH (obj);
+         if (NILP (type)) type = QINTEGER;
+         *format_ret = 16;
+         for (i = 0; i < (int) (*size_ret); i++)
+           if (CONSP (XVECTOR_DATA (obj) [i]))
+             *format_ret = 32;
+           else if (!INTP (XVECTOR_DATA (obj) [i]))
+             signal_error (Qerror, /* Qselection_error */
+                            list2 (build_string
+       ("all elements of the vector must be integers or conses of integers"),
+                                   obj));
+
+         *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8));
+         for (i = 0; i < (int) (*size_ret); i++)
+           if (*format_ret == 32)
+             (*((unsigned long **) data_ret)) [i] =
+               lisp_to_word (XVECTOR_DATA (obj) [i]);
+           else
+             (*((unsigned short **) data_ret)) [i] =
+               (unsigned short) lisp_to_word (XVECTOR_DATA (obj) [i]);
+       }
+    }
+  else
+    signal_error (Qerror, /* Qselection_error */
+                  list2 (build_string ("unrecognized selection data"),
+                         obj));
+
+  *type_ret = symbol_to_gtk_atom (d, type, 0);
+}
+
+\f
+
+static Lisp_Object
+gtk_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
+                  Lisp_Object how_to_add, Lisp_Object selection_type)
+{
+  struct device *d = decode_gtk_device (Qnil);
+  GtkWidget *selecting_window = GTK_WIDGET (DEVICE_GTK_APP_SHELL (d));
+  Lisp_Object selection_time;
+  /* Use the time of the last-read mouse or keyboard event.
+     For selection purposes, we use this as a sleazy way of knowing what the
+     current time is in server-time.  This assumes that the most recently read
+     mouse or keyboard event has something to do with the assertion of the
+     selection, which is probably true.
+     */
+  guint32 thyme = DEVICE_GTK_MOUSE_TIMESTAMP (d);
+  GdkAtom selection_atom;
+
+  CHECK_SYMBOL (selection_name);
+  selection_atom = symbol_to_gtk_atom (d, selection_name, 0);
+
+  gtk_selection_owner_set (selecting_window,
+                          selection_atom,
+                          thyme);
+
+  /* We do NOT use time_to_lisp() here any more, like we used to.
+     That assumed equivalence of time_t and Time, which is not
+     necessarily the case (e.g. under OSF on the Alphas, where
+     Time is a 64-bit quantity and time_t is a 32-bit quantity).
+
+     Opaque pointers are the clean way to go here.
+  */
+  selection_time = make_opaque (&thyme, sizeof (thyme));
+
+  return selection_time;
+}
+
+static void
+gtk_disown_selection (Lisp_Object selection, Lisp_Object timeval)
+{
+  struct device *d = decode_gtk_device (Qnil);
+  GdkAtom selection_atom;
+  guint32 timestamp;
+
+  CHECK_SYMBOL (selection);
+  selection_atom = symbol_to_gtk_atom (d, selection, 0);
+
+  if (NILP (timeval))
+    timestamp = DEVICE_GTK_MOUSE_TIMESTAMP (d);
+  else
+    {
+      time_t the_time;
+      lisp_to_time (timeval, &the_time);
+      timestamp = (guint32) the_time;
+    }
+
+  gtk_selection_owner_set (NULL, selection_atom, timestamp);
+}
+
+static Lisp_Object
+gtk_selection_exists_p (Lisp_Object selection,
+                       Lisp_Object selection_type)
+{
+  struct device *d = decode_gtk_device (Qnil);
+  
+  return (gdk_selection_owner_get (symbol_to_gtk_atom (d, selection, 0)) ? Qt : Qnil);
+}
+
+
+ \f
+/************************************************************************/
+/*                            initialization                            */
+/************************************************************************/
+
+void
+syms_of_select_gtk (void)
+{
+}
+
+void
+console_type_create_select_gtk (void)
+{
+  CONSOLE_HAS_METHOD (gtk, own_selection);
+  CONSOLE_HAS_METHOD (gtk, disown_selection);
+  CONSOLE_HAS_METHOD (gtk, selection_exists_p);
+  CONSOLE_HAS_METHOD (gtk, get_foreign_selection);
+}
+
+void
+vars_of_select_gtk (void)
+{
+  staticpro (&Vretrieved_selection);
+  Vretrieved_selection = Qnil;
+
+  DEFVAR_LISP ("gtk-sent-selection-hooks", &Vgtk_sent_selection_hooks /*
+A function or functions to be called after we have responded to some
+other client's request for the value of a selection that we own.  The
+function(s) will be called with four arguments:
+  - the name of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD);
+  - the name of the selection-type which we were requested to convert the
+    selection into before sending (for example, STRING or LENGTH);
+  - and whether we successfully transmitted the selection.
+We might have failed (and declined the request) for any number of reasons,
+including being asked for a selection that we no longer own, or being asked
+to convert into a type that we don't know about or that is inappropriate.
+This hook doesn't let you change the behavior of emacs's selection replies,
+it merely informs you that they have happened.
+*/ );
+  Vgtk_sent_selection_hooks = Qunbound;
+}

diff --git a/src/toolbar-gtk.c b/src/toolbar-gtk.c
new file mode 100644 (file)
index 0000000..f2ec8c5
--- /dev/null
+++ b/src/toolbar-gtk.c
@@ -0,0 +1,671 @@
+/* toolbar implementation -- X interface.
+   Copyright (C) 1995 Board of Trustees, University of Illinois.
+   Copyright (C) 1995 Sun Microsystems, Inc.
+   Copyright (C) 1995, 1996 Ben Wing.
+   Copyright (C) 1996 Chuck Thompson.
+
+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, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with: Not in FSF. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "console-gtk.h"
+#include "glyphs-gtk.h"
+#include "objects-gtk.h"
+#include "gtk-xemacs.h"
+#include "gccache-gtk.h"
+
+#include "faces.h"
+#include "frame.h"
+#include "toolbar.h"
+#include "window.h"
+
+extern GdkGC *gtk_get_gc (struct device *d, Lisp_Object font, Lisp_Object fg, Lisp_Object bg,
+                         Lisp_Object bg_pmap, Lisp_Object lwidth);
+
+static GdkGC *get_toolbar_gc (struct frame *f)
+{
+  Lisp_Object fg, bg;
+  Lisp_Object frame;
+
+  XSETFRAME (frame, f);
+
+  fg = Fspecifier_instance (Fget (Vtoolbar_face, Qforeground, Qnil), frame, Qnil, Qnil);
+  bg = Fspecifier_instance (Fget (Vtoolbar_face, Qbackground, Qnil), frame, Qnil, Qnil);
+                                  
+  /* Need to swap the foreground/background here or most themes look bug ugly */
+  return (gtk_get_gc (XDEVICE (FRAME_DEVICE (f)), Qnil, bg, fg, Qnil, Qnil));
+}
+
+static void
+gtk_draw_blank_toolbar_button (struct frame *f, int x, int y, int width,
+                              int height, int threed, int border_width,
+                              int vertical)
+{
+  GtkXEmacs *ef = GTK_XEMACS (FRAME_GTK_TEXT_WIDGET (f));
+  int sx = x, sy = y, swidth = width, sheight = height;
+  GdkWindow *x_win = GTK_WIDGET (ef)->window;
+  GdkGC *background_gc = get_toolbar_gc (f);
+
+  if (vertical)
+    {
+      sx += border_width;
+      swidth -= 2 * border_width;
+    }
+  else
+    {
+      sy += border_width;
+      sheight -= 2 * border_width;
+    }
+
+  /* Blank the entire area. */
+  gdk_draw_rectangle (x_win, background_gc, TRUE, sx, sy, swidth, sheight);
+
+  /* Draw the outline. */
+  if (threed)
+    gtk_output_shadows (f, sx, sy, swidth, sheight, 2);
+
+  /* Do the border */
+  gdk_draw_rectangle (x_win, background_gc, TRUE, x, y,
+                     (vertical ? border_width : width),
+                     (vertical ? height : border_width));
+  gdk_draw_rectangle (x_win, background_gc, TRUE,
+                     (vertical ? sx + swidth : x),
+                     (vertical ? y : sy + sheight),
+                     (vertical ? border_width : width),
+                     (vertical ? height : border_width));
+}
+
+static void
+gtk_output_toolbar_button (struct frame *f, Lisp_Object button)
+{
+  int shadow_thickness = 2;
+  int x_adj, y_adj, width_adj, height_adj;
+  GdkWindow *x_win = FRAME_GTK_TEXT_WIDGET (f)->window;
+  GdkGC *background_gc = get_toolbar_gc (f);
+  Lisp_Object instance, frame, window, glyph;
+  struct toolbar_button *tb = XTOOLBAR_BUTTON (button);
+  struct Lisp_Image_Instance *p;
+  struct window *w;
+  int vertical = tb->vertical;
+  int border_width = tb->border_width;
+
+  if (vertical)
+    {
+      x_adj = border_width;
+      width_adj = - 2 * border_width;
+      y_adj = 0;
+      height_adj = 0;
+    }
+  else
+    {
+      x_adj = 0;
+      width_adj = 0;
+      y_adj = border_width;
+      height_adj = - 2 * border_width;
+    }
+
+  XSETFRAME (frame, f);
+  window = FRAME_LAST_NONMINIBUF_WINDOW (f);
+  w = XWINDOW (window);
+
+  glyph = get_toolbar_button_glyph (w, tb);
+
+  if (tb->enabled)
+    {
+      if (tb->down)
+       {
+         shadow_thickness = -2;
+       }
+      else
+       {
+         shadow_thickness = 2;
+       }
+    }
+  else
+    {
+      shadow_thickness = 0;
+    }
+
+  background_gc = get_toolbar_gc (f);
+
+  /* Clear the entire area. */
+  gdk_draw_rectangle (x_win, background_gc, TRUE,
+                     tb->x + x_adj,
+                     tb->y + y_adj,
+                     tb->width + width_adj,
+                     tb->height + height_adj);
+
+  /* Draw the outline. */
+  if (shadow_thickness)
+    gtk_output_shadows (f, tb->x + x_adj, tb->y + y_adj,
+                       tb->width + width_adj, tb->height + height_adj,
+                       shadow_thickness);
+
+  /* Do the border. */
+  gdk_draw_rectangle (x_win, background_gc, TRUE, tb->x, tb->y,
+                     (vertical ? border_width : tb->width),
+                     (vertical ? tb->height : border_width));
+
+  gdk_draw_rectangle (x_win, background_gc, TRUE,
+                     (vertical ? tb->x + tb->width - border_width : tb->x),
+                     (vertical ? tb->y : tb->y + tb->height - border_width),
+                     (vertical ? border_width : tb->width),
+                     (vertical ? tb->height : border_width));
+
+  background_gc = get_toolbar_gc (f);
+
+  /* #### It is currently possible for users to trash us by directly
+     changing the toolbar glyphs.  Avoid crashing in that case. */
+  if (GLYPHP (glyph))
+    instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
+  else
+    instance = Qnil;
+
+  if (IMAGE_INSTANCEP (instance))
+    {
+      int width = tb->width + width_adj - shadow_thickness * 2;
+      int height = tb->height + height_adj - shadow_thickness * 2;
+      int x_offset = x_adj + shadow_thickness;
+      int y_offset = y_adj + shadow_thickness;
+
+      p = XIMAGE_INSTANCE (instance);
+
+      if (IMAGE_INSTANCE_PIXMAP_TYPE_P (p))
+       {
+         if (width > (int) IMAGE_INSTANCE_PIXMAP_WIDTH (p))
+           {
+             x_offset += ((int) (width - IMAGE_INSTANCE_PIXMAP_WIDTH (p))
+                          / 2);
+             width = IMAGE_INSTANCE_PIXMAP_WIDTH (p);
+           }
+         if (height > (int) IMAGE_INSTANCE_PIXMAP_HEIGHT (p))
+           {
+             y_offset += ((int) (height - IMAGE_INSTANCE_PIXMAP_HEIGHT (p))
+                          / 2);
+             height = IMAGE_INSTANCE_PIXMAP_HEIGHT (p);
+           }
+
+         gtk_output_gdk_pixmap (f, XIMAGE_INSTANCE (instance), tb->x + x_offset,
+                                tb->y + y_offset, 0, 0, 0, 0, width, height,
+                                0, 0, 0, background_gc);
+       }
+      else if (IMAGE_INSTANCE_TYPE (p) == IMAGE_TEXT)
+       {
+         /* #### We need to make the face used configurable. */
+         struct face_cachel *cachel =
+           WINDOW_FACE_CACHEL (w, DEFAULT_INDEX);
+         struct display_line dl;
+         Lisp_Object string = IMAGE_INSTANCE_TEXT_STRING (p);
+         unsigned char charsets[NUM_LEADING_BYTES];
+         Emchar_dynarr *buf;
+         struct font_metric_info fm;
+
+         /* This could be true if we were called via the Expose event
+             handler.  Mark the button as dirty and return
+             immediately. */
+         if (f->window_face_cache_reset)
+           {
+             tb->dirty = 1;
+             MARK_TOOLBAR_CHANGED;
+             return;
+           }
+         buf = Dynarr_new (Emchar);
+         convert_bufbyte_string_into_emchar_dynarr
+           (XSTRING_DATA (string), XSTRING_LENGTH (string), buf);
+         find_charsets_in_emchar_string (charsets, Dynarr_atp (buf, 0),
+                                         Dynarr_length (buf));
+         ensure_face_cachel_complete (cachel, window, charsets);
+         face_cachel_charset_font_metric_info (cachel, charsets, &fm);
+
+         dl.ascent = fm.ascent;
+         dl.descent = fm.descent;
+         dl.ypos = tb->y + y_offset + fm.ascent;
+
+         if (fm.ascent + fm.descent <= height)
+           {
+             dl.ypos += (height - fm.ascent - fm.descent) / 2;
+             dl.clip = 0;
+           }
+         else
+           {
+             dl.clip = fm.ascent + fm.descent - height;
+           }
+
+         gtk_output_string (w, &dl, buf, tb->x + x_offset, 0, 0, width,
+                            DEFAULT_INDEX, 0, 0, 0, 0);
+         Dynarr_free (buf);
+       }
+
+      /* We silently ignore the image if it isn't a pixmap or text. */
+    }
+
+  tb->dirty = 0;
+}
+
+static int
+gtk_get_button_size (struct frame *f, Lisp_Object window,
+                    struct toolbar_button *tb, int vert, int pos)
+{
+  int shadow_thickness = 2;
+  int size;
+
+  if (tb->blank)
+    {
+      if (!NILP (tb->down_glyph))
+       size = XINT (tb->down_glyph);
+      else
+       size = DEFAULT_TOOLBAR_BLANK_SIZE;
+    }
+  else
+    {
+      struct window *w = XWINDOW (window);
+      Lisp_Object glyph = get_toolbar_button_glyph (w, tb);
+
+      /* Unless, of course, the user has done something stupid like
+         change the glyph out from under us.  Use a blank placeholder
+         in that case. */
+      if (NILP (glyph))
+       return XINT (f->toolbar_size[pos]);
+
+      if (vert)
+       size = glyph_height (glyph, window);
+      else
+       size = glyph_width (glyph, window);
+    }
+
+  if (!size)
+    {
+      /* If the glyph doesn't have a size we'll insert a blank
+         placeholder instead. */
+      return XINT (f->toolbar_size[pos]);
+    }
+
+  size += shadow_thickness * 2;
+
+  return (size);
+}
+
+#define GTK_OUTPUT_BUTTONS_LOOP(left)                                  \
+  do {                                                                 \
+    while (!NILP (button))                                             \
+      {                                                                        \
+       struct toolbar_button *tb = XTOOLBAR_BUTTON (button);           \
+       int size, height, width;                                        \
+                                                                       \
+       if (left && tb->pushright)                                      \
+         break;                                                        \
+                                                                       \
+        size = gtk_get_button_size (f, window, tb, vert, pos);         \
+                                                                       \
+       if (vert)                                                       \
+         {                                                             \
+           width = bar_width;                                          \
+           if (y + size > max_pixpos)                                  \
+             height = max_pixpos - y;                                  \
+           else                                                        \
+             height = size;                                            \
+         }                                                             \
+       else                                                            \
+         {                                                             \
+           if (x + size > max_pixpos)                                  \
+             width = max_pixpos - x;                                   \
+           else                                                        \
+             width = size;                                             \
+           height = bar_height;                                        \
+         }                                                             \
+                                                                       \
+       if (tb->x != x                                                  \
+           || tb->y != y                                               \
+           || tb->width != width                                       \
+           || tb->height != height                                     \
+           || tb->dirty)                                               \
+         {                                                             \
+           if (width && height)                                        \
+             {                                                         \
+               tb->x = x;                                              \
+               tb->y = y;                                              \
+               tb->width = width;                                      \
+               tb->height = height;                                    \
+               tb->border_width = border_width;                        \
+               tb->vertical = vert;                                    \
+                                                                       \
+                if (tb->blank || NILP (tb->up_glyph))                  \
+                 {                                                     \
+                   int threed = (EQ (Qt, tb->up_glyph) ? 1 : 0);       \
+                   gtk_draw_blank_toolbar_button (f, x, y, width,      \
+                                                height, threed,        \
+                                                border_width, vert);   \
+                 }                                                     \
+               else                                                    \
+                 gtk_output_toolbar_button (f, button);                \
+             }                                                         \
+         }                                                             \
+                                                                       \
+       if (vert)                                                       \
+         y += height;                                                  \
+       else                                                            \
+         x += width;                                                   \
+                                                                       \
+       if ((vert && y == max_pixpos) || (!vert && x == max_pixpos))    \
+         button = Qnil;                                                \
+       else                                                            \
+         button = tb->next;                                            \
+      }                                                                        \
+  } while (0)
+
+#define SET_TOOLBAR_WAS_VISIBLE_FLAG(frame, pos, flag)                 \
+  do {                                                                 \
+    switch (pos)                                                       \
+      {                                                                        \
+      case TOP_TOOLBAR:                                                        \
+       (frame)->top_toolbar_was_visible = flag;                        \
+       break;                                                          \
+      case BOTTOM_TOOLBAR:                                             \
+       (frame)->bottom_toolbar_was_visible = flag;                     \
+       break;                                                          \
+      case LEFT_TOOLBAR:                                               \
+       (frame)->left_toolbar_was_visible = flag;                       \
+       break;                                                          \
+      case RIGHT_TOOLBAR:                                              \
+       (frame)->right_toolbar_was_visible = flag;                      \
+       break;                                                          \
+      default:                                                         \
+       abort ();                                                       \
+      }                                                                        \
+  } while (0)
+
+static void
+gtk_output_toolbar (struct frame *f, enum toolbar_pos pos)
+{
+  int x, y, bar_width, bar_height, vert;
+  int max_pixpos, right_size, right_start, blank_size;
+  int border_width = FRAME_REAL_TOOLBAR_BORDER_WIDTH (f, pos);
+  Lisp_Object button, window;
+  GdkWindow *x_win = FRAME_GTK_TEXT_WIDGET (f)->window;
+  GdkGC *background_gc = get_toolbar_gc (f);
+
+  get_toolbar_coords (f, pos, &x, &y, &bar_width, &bar_height, &vert, 1);
+  window = FRAME_LAST_NONMINIBUF_WINDOW (f);
+
+  /* Do the border */
+  gdk_draw_rectangle (x_win, background_gc, TRUE, x, y,
+                     (vert ? bar_width : border_width),
+                     (vert ? border_width : bar_height));
+  gdk_draw_rectangle (x_win, background_gc, TRUE,
+                     (vert ? x : x + bar_width - border_width),
+                     (vert ? y + bar_height - border_width : y),
+                     (vert ? bar_width : border_width),
+                     (vert ? border_width : bar_height));
+
+  if (vert)
+    {
+      max_pixpos = y + bar_height - border_width;
+      y += border_width;
+    }
+  else
+    {
+      max_pixpos = x + bar_width - border_width;
+      x += border_width;
+    }
+
+  button = FRAME_TOOLBAR_BUTTONS (f, pos);
+  right_size = 0;
+
+  /* First loop over all of the buttons to determine how much room we
+     need for left hand and right hand buttons.  This loop will also
+     make sure that all instances are instantiated so when we actually
+     output them they will come up immediately. */
+  while (!NILP (button))
+    {
+      struct toolbar_button *tb = XTOOLBAR_BUTTON (button);
+      int size = gtk_get_button_size (f, window, tb, vert, pos);
+
+      if (tb->pushright)
+       right_size += size;
+
+      button = tb->next;
+    }
+
+  button = FRAME_TOOLBAR_BUTTONS (f, pos);
+
+  /* Loop over the left buttons, updating and outputting them. */
+  GTK_OUTPUT_BUTTONS_LOOP (1);
+
+  /* Now determine where the right buttons start. */
+  right_start = max_pixpos - right_size;
+  if (right_start < (vert ? y : x))
+    right_start = (vert ? y : x);
+
+  /* Output the blank which goes from the end of the left buttons to
+     the start of the right. */
+  blank_size = right_start - (vert ? y : x);
+  if (blank_size)
+    {
+      int height, width;
+
+      if (vert)
+       {
+         width = bar_width;
+         height = blank_size;
+       }
+      else
+       {
+         width = blank_size;
+         height = bar_height;
+       }
+
+      /*
+       * Use a 3D pushright separator only if there isn't a toolbar
+       * border.  A flat separator meshes with the border and looks
+       * better.
+       */
+      gtk_draw_blank_toolbar_button (f, x, y, width, height, !border_width,
+                                    border_width, vert);
+
+      if (vert)
+       y += height;
+      else
+       x += width;
+    }
+
+  /* Loop over the right buttons, updating and outputting them. */
+  GTK_OUTPUT_BUTTONS_LOOP (0);
+
+  if (!vert)
+    {
+      Lisp_Object frame;
+
+      XSETFRAME (frame, f);
+      redisplay_clear_region (frame,
+                             DEFAULT_INDEX, FRAME_PIXWIDTH (f) - 1, y, 1,
+                             bar_height);
+    }
+
+  SET_TOOLBAR_WAS_VISIBLE_FLAG (f, pos, 1);
+
+  gdk_flush ();
+}
+
+static void
+gtk_clear_toolbar (struct frame *f, enum toolbar_pos pos, int thickness_change)
+{
+  Lisp_Object frame;
+  int x, y, width, height, vert;
+
+  get_toolbar_coords (f, pos, &x, &y, &width, &height, &vert, 1);
+  XSETFRAME (frame, f);
+
+  /* The thickness_change parameter is used by the toolbar resize routines
+     to clear any excess toolbar if the size shrinks. */
+  if (thickness_change < 0)
+    {
+      if (pos == LEFT_TOOLBAR || pos == RIGHT_TOOLBAR)
+       {
+         x = x + width + thickness_change;
+         width = -thickness_change;
+       }
+      else
+       {
+         y = y + height + thickness_change;
+         height = -thickness_change;
+       }
+    }
+
+  SET_TOOLBAR_WAS_VISIBLE_FLAG (f, pos, 0);
+
+  redisplay_clear_region (frame, DEFAULT_INDEX, x, y, width, height);
+  gdk_flush ();
+}
+
+static void
+gtk_output_frame_toolbars (struct frame *f)
+{
+  assert (FRAME_GTK_P (f));
+
+  if (FRAME_REAL_TOP_TOOLBAR_VISIBLE (f))
+    gtk_output_toolbar (f, TOP_TOOLBAR);
+  else if (f->top_toolbar_was_visible)
+    gtk_clear_toolbar (f, TOP_TOOLBAR, 0);
+
+  if (FRAME_REAL_BOTTOM_TOOLBAR_VISIBLE (f))
+    gtk_output_toolbar (f, BOTTOM_TOOLBAR);
+  else if (f->bottom_toolbar_was_visible)
+    gtk_clear_toolbar (f, BOTTOM_TOOLBAR, 0);
+
+  if (FRAME_REAL_LEFT_TOOLBAR_VISIBLE (f))
+    gtk_output_toolbar (f, LEFT_TOOLBAR);
+  else if (f->left_toolbar_was_visible)
+    gtk_clear_toolbar (f, LEFT_TOOLBAR, 0);
+
+  if (FRAME_REAL_RIGHT_TOOLBAR_VISIBLE (f))
+    gtk_output_toolbar (f, RIGHT_TOOLBAR);
+  else if (f->right_toolbar_was_visible)
+    gtk_clear_toolbar (f, RIGHT_TOOLBAR, 0);
+}
+
+static void
+gtk_redraw_exposed_toolbar (struct frame *f, enum toolbar_pos pos, int x, int y,
+                           int width, int height)
+{
+  int bar_x, bar_y, bar_width, bar_height, vert;
+  Lisp_Object button = FRAME_TOOLBAR_BUTTONS (f, pos);
+
+  get_toolbar_coords (f, pos, &bar_x, &bar_y, &bar_width, &bar_height,
+                     &vert, 1);
+
+  if (((y + height) < bar_y) || (y > (bar_y + bar_height)))
+    return;
+  if (((x + width) < bar_x) || (x > (bar_x + bar_width)))
+    return;
+
+  while (!NILP (button))
+    {
+      struct toolbar_button *tb = XTOOLBAR_BUTTON (button);
+
+      if (vert)
+       {
+         if (((tb->y + tb->height) > y) && (tb->y < (y + height)))
+           tb->dirty = 1;
+
+         /* If this is true we have gone past the exposed region. */
+         if (tb->y > (y + height))
+           break;
+       }
+      else
+       {
+         if (((tb->x + tb->width) > x) && (tb->x < (x + width)))
+           tb->dirty = 1;
+
+         /* If this is true we have gone past the exposed region. */
+         if (tb->x > (x + width))
+           break;
+       }
+
+      button = tb->next;
+    }
+
+  /* Even if none of the buttons is in the area, the blank region at
+     the very least must be because the first thing we did is verify
+     that some portion of the toolbar is in the exposed region. */
+  gtk_output_toolbar (f, pos);
+}
+
+static void
+gtk_redraw_exposed_toolbars (struct frame *f, int x, int y, int width,
+                            int height)
+{
+  assert (FRAME_GTK_P (f));
+
+  if (FRAME_REAL_TOP_TOOLBAR_VISIBLE (f))
+    gtk_redraw_exposed_toolbar (f, TOP_TOOLBAR, x, y, width, height);
+
+  if (FRAME_REAL_BOTTOM_TOOLBAR_VISIBLE (f))
+    gtk_redraw_exposed_toolbar (f, BOTTOM_TOOLBAR, x, y, width, height);
+
+  if (FRAME_REAL_LEFT_TOOLBAR_VISIBLE (f))
+    gtk_redraw_exposed_toolbar (f, LEFT_TOOLBAR, x, y, width, height);
+
+  if (FRAME_REAL_RIGHT_TOOLBAR_VISIBLE (f))
+    gtk_redraw_exposed_toolbar (f, RIGHT_TOOLBAR, x, y, width, height);
+}
+
+static void
+gtk_redraw_frame_toolbars (struct frame *f)
+{
+  /* There are certain startup paths that lead to update_EmacsFrame in
+     faces.c being called before a new frame is fully initialized.  In
+     particular before we have actually mapped it.  That routine can
+     call this one.  So, we need to make sure that the frame is
+     actually ready before we try and draw all over it. */
+
+  if (GTK_WIDGET_REALIZED (FRAME_GTK_TEXT_WIDGET (f)))
+    gtk_redraw_exposed_toolbars (f, 0, 0, FRAME_PIXWIDTH (f),
+                                FRAME_PIXHEIGHT (f));
+}
+
+\f
+static void
+gtk_initialize_frame_toolbars (struct frame *f)
+{
+}
+
+/* This only calls one function but we go ahead and create this in
+   case we ever do decide that we need to do more work. */
+static void
+gtk_free_frame_toolbars (struct frame *f)
+{
+}
+
+\f
+/************************************************************************/
+/*                            initialization                            */
+/************************************************************************/
+
+void
+console_type_create_toolbar_gtk (void)
+{
+  CONSOLE_HAS_METHOD (gtk, output_frame_toolbars);
+  CONSOLE_HAS_METHOD (gtk, initialize_frame_toolbars);
+  CONSOLE_HAS_METHOD (gtk, free_frame_toolbars);
+  CONSOLE_HAS_METHOD (gtk, output_toolbar_button);
+  CONSOLE_HAS_METHOD (gtk, redraw_exposed_toolbars);
+  CONSOLE_HAS_METHOD (gtk, redraw_frame_toolbars);
+}

diff --git a/src/ui-byhand.c b/src/ui-byhand.c
new file mode 100644 (file)
index 0000000..ac1960c
--- /dev/null
+++ b/src/ui-byhand.c
@@ -0,0 +1,692 @@
+/* I really wish this entire file could go away, but there is
+   currently no way to do the following in the Foreign Function
+   Interface:
+
+   1) Deal with return values in the parameter list (ie: int *foo)
+
+   So we have to code a few functions by hand.  Ick.
+
+   William M. Perry 5/8/00
+*/
+
+#include "gui.h"
+
+DEFUN ("gtk-box-query-child-packing", Fgtk_box_query_child_packing, 2, 2,0, /*
+Returns information about how CHILD is packed into BOX.
+Return value is a list of (EXPAND FILL PADDING PACK_TYPE).
+*/
+       (box, child))
+{
+  gboolean expand, fill;
+  guint padding;
+  GtkPackType pack_type;
+  Lisp_Object result = Qnil;
+  
+  CHECK_GTK_OBJECT (box);
+  CHECK_GTK_OBJECT (child);
+
+  if (!GTK_IS_BOX (XGTK_OBJECT (box)->object))
+    {
+      signal_simple_error ("Object is not a GtkBox", box);
+    }
+
+  if (!GTK_IS_WIDGET (XGTK_OBJECT (child)->object))
+    {
+      signal_simple_error ("Child is not a GtkWidget", child);
+    }
+
+  gtk_box_query_child_packing (GTK_BOX (XGTK_OBJECT (box)->object),
+                              GTK_WIDGET (XGTK_OBJECT (child)->object),
+                              &expand, &fill, &padding, &pack_type);
+
+  result = Fcons (make_int (pack_type), result);
+  result = Fcons (make_int (padding), result);
+  result = Fcons (fill ? Qt : Qnil, result);
+  result = Fcons (expand ? Qt : Qnil, result);
+
+  return (result);
+}
+
+/* void gtk_button_box_get_child_size_default (gint *min_width, gint *min_height); */
+DEFUN ("gtk-button-box-get-child-size-default",
+       Fgtk_button_box_get_child_size_default, 0, 0, 0, /*
+Return a cons cell (WIDTH . HEIGHT) of the default button box child size.
+*/
+       ())
+{
+  gint width, height;
+
+  gtk_button_box_get_child_size_default (&width, &height);
+
+  return (Fcons (make_int (width), make_int (height)));
+}
+
+/* void gtk_button_box_get_child_ipadding_default (gint *ipad_x, gint *ipad_y);  */
+DEFUN ("gtk-button-box-get-child-ipadding-default",
+       Fgtk_button_box_get_child_ipadding_default, 0, 0, 0, /*
+Return a cons cell (X . Y) of the default button box ipadding.
+*/
+       ())
+{
+  gint x, y;
+
+  gtk_button_box_get_child_ipadding_default (&x, &y);
+
+  return (Fcons (make_int (x), make_int (y)));
+}
+
+/* void gtk_button_box_get_child_size (GtkButtonBox *widget,
+   gint *min_width, gint *min_height); */
+DEFUN ("gtk-button-box-get-child-size", Fgtk_button_box_get_child_size, 1, 1, 0, /*
+Get the current size of a child in the buttonbox BOX.
+*/
+       (box))
+{
+  gint width, height;
+
+  CHECK_GTK_OBJECT (box);
+
+  if (!GTK_IS_BUTTON_BOX (XGTK_OBJECT (box)->object))
+    {
+      signal_simple_error ("Not a GtkBox object", box);
+    }
+
+  gtk_button_box_get_child_size (GTK_BUTTON_BOX (XGTK_OBJECT (box)->object),
+                                &width, &height);
+
+  return (Fcons (make_int (width), make_int (height)));
+}
+
+/* void gtk_button_box_get_child_ipadding (GtkButtonBox *widget, gint *ipad_x, gint *ipad_y); */
+DEFUN ("gtk-button-box-get-child-ipadding",
+       Fgtk_button_box_get_child_ipadding, 1, 1, 0, /*
+Return a cons cell (X . Y) of the current buttonbox BOX ipadding.
+*/
+       (box))
+{
+  gint x, y;
+
+  CHECK_GTK_OBJECT (box);
+
+  if (!GTK_IS_BUTTON_BOX (XGTK_OBJECT (box)->object))
+    {
+      signal_simple_error ("Not a GtkBox object", box);
+    }
+
+  gtk_button_box_get_child_ipadding (GTK_BUTTON_BOX (XGTK_OBJECT (box)->object),
+                                    &x, &y);
+
+  return (Fcons (make_int (x), make_int (y)));
+}
+
+/*void    gtk_calendar_get_date        (GtkCalendar *calendar, 
+                                        guint       *year,
+                                        guint       *month,
+                                        guint       *day);
+*/
+DEFUN ("gtk-calendar-get-date", Fgtk_calendar_get_date, 1, 1, 0, /*
+Return a list of (YEAR MONTH DAY) from the CALENDAR object.
+*/
+       (calendar))
+{
+  guint year, month, day;
+
+  CHECK_GTK_OBJECT (calendar);
+
+  if (!GTK_IS_CALENDAR (XGTK_OBJECT (calendar)->object))
+    {
+      signal_simple_error ("Not a GtkCalendar object", calendar);
+    }
+
+  gtk_calendar_get_date (GTK_CALENDAR (XGTK_OBJECT (calendar)->object),
+                        &year, &month, &day);
+
+  return (list3 (make_int (year), make_int (month), make_int (day)));
+}
+
+/* gint gtk_clist_get_text (GtkCList  *clist,
+                        gint       row,
+                        gint       column,
+                        gchar    **text);
+*/
+DEFUN ("gtk-clist-get-text", Fgtk_clist_get_text, 3, 3, 0, /*
+Returns the text from GtkCList OBJ cell at coordinates ROW, COLUMN.
+*/
+       (obj, row, column))
+{
+  gchar *text = NULL;
+  Lisp_Object rval = Qnil;
+
+  CHECK_GTK_OBJECT (obj);
+  CHECK_INT (row);
+  CHECK_INT (column);
+
+  if (!GTK_IS_CLIST (XGTK_OBJECT (obj)->object))
+    {
+      signal_simple_error ("Object is not a GtkCList", obj);
+    }
+
+  gtk_clist_get_text (GTK_CLIST (XGTK_OBJECT (obj)->object), XINT (row), XINT (column), &text);
+
+  if (text)
+    {
+      rval = build_string (text);
+      /* NOTE: This is NOT a memory leak.  GtkCList returns a pointer
+        to internally used memory, not a copy of it.
+        g_free (text);
+      */
+    }
+
+  return (rval);
+}
+
+/* gint gtk_clist_get_selection_info (GtkCList *clist,
+                                  gint      x,
+                                  gint      y,
+                                  gint     *row,
+                                  gint *column); */
+DEFUN ("gtk-clist-get-selection-info", Fgtk_clist_get_selection, 3, 3, 0, /*
+Returns a cons cell of (ROW . COLUMN) of the GtkCList OBJ at coordinates X, Y.
+*/
+       (obj, x, y))
+{
+  gint row, column;
+
+  CHECK_GTK_OBJECT (obj);
+  CHECK_INT (x);
+  CHECK_INT (y);
+
+  if (!GTK_IS_CLIST (XGTK_OBJECT (obj)->object))
+    {
+      signal_simple_error ("Object is not a GtkCList", obj);
+    }
+
+  gtk_clist_get_selection_info (GTK_CLIST (XGTK_OBJECT (obj)->object),
+                               XINT (x), XINT (y), &row, &column);
+
+  return (Fcons (make_int (row), make_int (column)));
+}
+
+DEFUN ("gtk-clist-get-pixmap", Fgtk_clist_get_pixmap, 3, 3, 0, /*
+Return a cons of (pixmap . mask) at ROW,COLUMN in CLIST.
+*/
+       (clist, row, column))
+{
+  GdkPixmap *pixmap = NULL;
+  GdkBitmap *mask = NULL;
+
+  CHECK_GTK_OBJECT (clist);
+  CHECK_INT (row);
+  CHECK_INT (column);
+
+  if (!GTK_IS_CLIST (XGTK_OBJECT (clist)->object))
+    {
+      signal_simple_error ("Object is not a GtkCList", clist);
+    }
+
+  gtk_clist_get_pixmap (GTK_CLIST (XGTK_OBJECT (clist)->object),
+                       XINT (row), XINT (column),
+                       &pixmap, &mask);
+
+  return (Fcons (pixmap ? build_gtk_boxed (pixmap, GTK_TYPE_GDK_WINDOW) : Qnil,
+                mask ? build_gtk_boxed (mask, GTK_TYPE_GDK_WINDOW) : Qnil));
+}
+
+DEFUN ("gtk-clist-get-pixtext", Fgtk_clist_get_pixtext, 3, 3, 0, /*
+Return a list of (pixmap mask text) at ROW,COLUMN in CLIST.
+*/
+       (clist, row, column))
+{
+  GdkPixmap *pixmap = NULL;
+  GdkBitmap *mask = NULL;
+  char *text = NULL;
+  guint8 spacing;
+
+  CHECK_GTK_OBJECT (clist);
+  CHECK_INT (row);
+  CHECK_INT (column);
+
+  if (!GTK_IS_CLIST (XGTK_OBJECT (clist)->object))
+    {
+      signal_simple_error ("Object is not a GtkCList", clist);
+    }
+
+  gtk_clist_get_pixtext (GTK_CLIST (XGTK_OBJECT (clist)->object),
+                        XINT (row), XINT (column), &text, &spacing,
+                        &pixmap, &mask);
+
+  return (list3 (pixmap ? build_gtk_boxed (pixmap, GTK_TYPE_GDK_WINDOW) : Qnil,
+                mask ? build_gtk_boxed (mask, GTK_TYPE_GDK_WINDOW) : Qnil,
+                (text && text[0]) ? build_string (text) : Qnil));
+}
+
+/* void gtk_color_selection_get_color(GtkColorSelection *colorsel, gdouble *color); */
+DEFUN ("gtk-color-selection-get-color", Fgtk_color_selection_get_color, 1, 1, 0, /*
+Return a list of (RED GREEN BLUE ALPHA) from the GtkColorSelection OBJECT.
+*/
+       (object))
+{
+  gdouble rgba[4];
+
+  CHECK_GTK_OBJECT (object);
+
+  if (!GTK_IS_COLOR_SELECTION (XGTK_OBJECT (object)->object))
+    {
+      signal_simple_error ("Object is not a GtkColorSelection", object);
+    }
+
+  gtk_color_selection_get_color (GTK_COLOR_SELECTION (XGTK_OBJECT (object)), rgba);
+
+  return (list4 (make_float (rgba[0]),
+                make_float (rgba[1]),
+                make_float (rgba[2]),
+                make_float (rgba[3])));
+}
+
+/* (gtk-import-function nil "gtk_editable_insert_text" 'GtkEditable 'GtkString 'gint 'pointer-to-gint) */
+DEFUN ("gtk-editable-insert-text", Fgtk_editable_insert_text, 3, 3, 0, /*
+Insert text STRINT at POS in GtkEditable widget OBJ.
+Returns the new position of the cursor in the widget.
+*/
+       (obj, string, pos))
+{
+  gint the_pos;
+
+  CHECK_GTK_OBJECT (obj);
+  CHECK_STRING (string);
+  CHECK_INT (pos);
+
+  the_pos = XINT (pos);
+
+  if (!GTK_IS_EDITABLE (XGTK_OBJECT (obj)->object))
+    {
+      signal_simple_error ("Object is not a GtkEditable", obj);
+    }
+
+  gtk_editable_insert_text (GTK_EDITABLE (XGTK_OBJECT (obj)->object),
+                           (char *) XSTRING_DATA (string),
+                           XSTRING_LENGTH (string),
+                           &the_pos);
+
+  return (make_int (the_pos));
+}
+
+DEFUN ("gtk-pixmap-get", Fgtk_pixmap_get, 1, 1, 0, /*
+Return a cons cell of (PIXMAP . MASK) from GtkPixmap OBJECT.
+*/
+        (object))
+{
+  GdkPixmap *pixmap, *mask;
+
+  CHECK_GTK_OBJECT (object);
+
+  if (!GTK_IS_PIXMAP (XGTK_OBJECT (object)->object))
+    {
+      signal_simple_error ("Object is not a GtkPixmap", object);
+    }
+
+  gtk_pixmap_get (GTK_PIXMAP (XGTK_OBJECT (object)->object), &pixmap, &mask);
+
+  return (Fcons (pixmap ? build_gtk_object (GTK_OBJECT (pixmap)) : Qnil,
+                mask ? build_gtk_object (GTK_OBJECT (mask)) : Qnil));
+}
+
+DEFUN ("gtk-curve-get-vector", Fgtk_curve_get_vector, 2, 2, 0, /*
+Returns a vector of LENGTH points representing the curve of CURVE.
+*/
+       (curve, length))
+{
+  gfloat *vector = NULL;
+  Lisp_Object lisp_vector = Qnil;
+  int i;
+
+  CHECK_GTK_OBJECT (curve);
+  CHECK_INT (length);
+
+  if (!GTK_IS_CURVE (XGTK_OBJECT (curve)->object))
+    {
+      signal_simple_error ("Object is not a GtkCurve", curve);
+    }
+
+  vector = (gfloat *) alloca (sizeof (gfloat) * XINT (length));
+
+  gtk_curve_get_vector (GTK_CURVE (XGTK_OBJECT (curve)->object), XINT (length), vector);
+  lisp_vector = make_vector (XINT (length), Qnil);
+
+  for (i = 0; i < XINT (length); i++)
+    {
+      XVECTOR_DATA (lisp_vector)[i] = make_float (vector[i]);
+    }
+
+  return (lisp_vector);
+}
+
+DEFUN ("gtk-curve-set-vector", Fgtk_curve_set_vector, 2, 2, 0, /*
+Set the vector of points on CURVE to VECTOR.
+*/
+       (curve, vector))
+{
+  gfloat *c_vector = NULL;
+  int vec_length = 0;
+  int i;
+
+  CHECK_GTK_OBJECT (curve);
+  CHECK_VECTOR (vector);
+
+  vec_length = XVECTOR_LENGTH (vector);
+
+  if (!GTK_IS_CURVE (XGTK_OBJECT (curve)->object))
+    {
+      signal_simple_error ("Object is not a GtkCurve", curve);
+    }
+
+  c_vector = (gfloat *) alloca (sizeof (gfloat) * vec_length);
+
+  for (i = 0; i < vec_length; i++)
+    {
+      CHECK_FLOAT (XVECTOR_DATA (vector)[i]);
+      c_vector[i] = extract_float (XVECTOR_DATA (vector)[i]);
+    }
+
+  gtk_curve_set_vector (GTK_CURVE (XGTK_OBJECT (curve)->object), vec_length, c_vector);
+  return (Qt);
+}
+
+DEFUN ("gtk-label-get", Fgtk_label_get, 1, 1, 0, /*
+Return the text of LABEL.
+*/
+       (label))
+{
+  gchar *string;
+
+  CHECK_GTK_OBJECT (label);
+
+  if (!GTK_IS_LABEL (XGTK_OBJECT (label)->object))
+    {
+      signal_simple_error ("Object is not a GtkLabel", label);
+    }
+
+  gtk_label_get (GTK_LABEL (XGTK_OBJECT (label)->object), &string);
+
+  return (build_string (string));
+}
+
+DEFUN ("gtk-notebook-query-tab-label-packing", Fgtk_notebook_query_tab_label_packing, 2, 2, 0, /*
+Return a list of packing information (EXPAND FILL PACK_TYPE) for CHILD in NOTEBOOK.
+*/
+       (notebook, child))
+{
+  gboolean expand, fill;
+  GtkPackType pack_type;
+
+  CHECK_GTK_OBJECT (notebook);
+  CHECK_GTK_OBJECT (child);
+
+  if (!GTK_IS_NOTEBOOK (XGTK_OBJECT (notebook)->object))
+    {
+      signal_simple_error ("Object is not a GtkLabel", notebook);
+    }
+
+  if (!GTK_IS_WIDGET (XGTK_OBJECT (child)->object))
+    {
+      signal_simple_error ("Object is not a GtkWidget", child);
+    }
+
+  gtk_notebook_query_tab_label_packing (GTK_NOTEBOOK (XGTK_OBJECT (notebook)->object),
+                                       GTK_WIDGET (XGTK_OBJECT (child)->object),
+                                       &expand, &fill, &pack_type);
+
+  return (list3 (expand ? Qt : Qnil, fill ? Qt : Qnil, make_int (pack_type)));
+}
+
+DEFUN ("gtk-widget-get-pointer", Fgtk_widget_get_pointer, 1, 1, 0, /*
+Return the pointer position relative to WIDGET as a cons of (X . Y).
+*/
+       (widget))
+{
+  gint x,y;
+  CHECK_GTK_OBJECT (widget);
+
+  if (!GTK_IS_WIDGET (XGTK_OBJECT (widget)->object))
+    {
+      signal_simple_error ("Object is not a GtkWidget", widget);
+    }
+
+  gtk_widget_get_pointer (GTK_WIDGET (XGTK_OBJECT (widget)->object), &x, &y);
+
+  return (Fcons (make_int (x), make_int (y)));
+}
+
+/* This is called whenever an item with a GUI_ID associated with it is
+   destroyed.  This allows us to remove the references in gui-gtk.c
+   that made sure callbacks and such were GCPRO-ed
+*/
+static void
+__remove_gcpro_by_id (gpointer user_data)
+{
+  ungcpro_popup_callbacks ((GUI_ID) user_data);
+}
+
+static void
+__generic_toolbar_callback (GtkWidget *item, gpointer user_data)
+{
+  Lisp_Object callback;
+  Lisp_Object lisp_user_data;
+
+  VOID_TO_LISP (callback, user_data);
+
+  lisp_user_data = XCAR (callback);
+  callback = XCDR (callback);
+
+  signal_special_gtk_user_event (Qnil, callback, lisp_user_data);
+}
+
+static Lisp_Object
+generic_toolbar_insert_item (Lisp_Object toolbar,
+                            Lisp_Object text,
+                            Lisp_Object tooltip_text,
+                            Lisp_Object tooltip_private_text,
+                            Lisp_Object icon,
+                            Lisp_Object callback,
+                            Lisp_Object data,
+                            Lisp_Object prepend_p,
+                            Lisp_Object position)
+{
+  GUI_ID id;
+  GtkWidget *w = NULL;
+
+  CHECK_GTK_OBJECT (toolbar);
+  CHECK_GTK_OBJECT (icon);
+  CHECK_STRING (text);
+  CHECK_STRING (tooltip_text);
+  CHECK_STRING (tooltip_private_text);
+
+  if (!SYMBOLP (callback) && !LISTP (callback))
+    {
+      signal_simple_error ("Callback must be symbol or eval-able form", callback);
+    }
+
+  if (!GTK_IS_TOOLBAR (XGTK_OBJECT (toolbar)->object))
+    {
+      signal_simple_error ("Object is not a GtkToolbar", toolbar);
+    }
+
+  if (!GTK_IS_WIDGET (XGTK_OBJECT (icon)->object))
+    {
+      signal_simple_error ("Object is not a GtkWidget", icon);
+    }
+
+  callback = Fcons (data, callback);
+
+  id = new_gui_id ();
+  gcpro_popup_callbacks (id, callback);
+  gtk_object_weakref (XGTK_OBJECT (toolbar)->object, __remove_gcpro_by_id,
+                     (gpointer) id);
+
+  if (NILP (position))
+    {
+      w = (NILP (prepend_p) ? gtk_toolbar_append_item : gtk_toolbar_prepend_item)
+       (GTK_TOOLBAR (XGTK_OBJECT (toolbar)->object),
+        XSTRING_DATA (text),
+        XSTRING_DATA (tooltip_text),
+        XSTRING_DATA (tooltip_private_text),
+        GTK_WIDGET (XGTK_OBJECT (icon)->object),
+        GTK_SIGNAL_FUNC (__generic_toolbar_callback),
+        LISP_TO_VOID (callback));
+    }
+  else
+    {
+      w = gtk_toolbar_insert_item (GTK_TOOLBAR (XGTK_OBJECT (toolbar)->object),
+                                  XSTRING_DATA (text),
+                                  XSTRING_DATA (tooltip_text),
+                                  XSTRING_DATA (tooltip_private_text),
+                                  GTK_WIDGET (XGTK_OBJECT (icon)->object),
+                                  GTK_SIGNAL_FUNC (__generic_toolbar_callback),
+                                  LISP_TO_VOID (callback),
+                                  XINT (position));
+    }
+
+
+  return (w ? build_gtk_object (GTK_OBJECT (w)) : Qnil);
+}
+
+DEFUN ("gtk-toolbar-append-item", Fgtk_toolbar_append_item, 6, 7, 0, /*
+Appends a new button to the given toolbar.
+*/
+          (toolbar, text, tooltip_text, tooltip_private_text, icon, callback, data))
+{
+  return (generic_toolbar_insert_item (toolbar,text,tooltip_text,tooltip_private_text,icon,callback,data,Qnil,Qnil));
+}
+
+DEFUN ("gtk-toolbar-prepend-item", Fgtk_toolbar_prepend_item, 6, 7, 0, /*
+Adds a new button to the beginning (left or top edges) of the given toolbar.
+*/
+          (toolbar, text, tooltip_text, tooltip_private_text, icon, callback, data))
+{
+  return (generic_toolbar_insert_item (toolbar,text,tooltip_text,tooltip_private_text,icon,callback,data,Qt,Qnil));
+}
+
+DEFUN ("gtk-toolbar-insert-item", Fgtk_toolbar_insert_item, 7, 8, 0, /*
+Adds a new button to the beginning (left or top edges) of the given toolbar.
+*/
+          (toolbar, text, tooltip_text, tooltip_private_text, icon, callback, position, data))
+{
+  CHECK_INT (position);
+
+  return (generic_toolbar_insert_item (toolbar,text,tooltip_text,tooltip_private_text,icon,callback,data,Qnil,position));
+}
+
+/* GtkCTree is an abomination in the eyes of the object system. */
+static void
+__emacs_gtk_ctree_recurse_internal (GtkCTree *ctree, GtkCTreeNode *node, gpointer user_data)
+{
+  Lisp_Object closure;
+
+  VOID_TO_LISP (closure, user_data);
+
+  call3 (XCAR (closure),
+        build_gtk_object (GTK_OBJECT (ctree)),
+        build_gtk_boxed (node, GTK_TYPE_CTREE_NODE),
+        XCDR (closure));
+}
+
+DEFUN ("gtk-ctree-recurse", Fgtk_ctree_recurse, 3, 6, 0, /*
+Recursively apply FUNC to all nodes of CTREE at or below NODE.
+FUNC is called with three arguments: CTREE, a GtkCTreeNode, and DATA.
+The return value of FUNC is ignored.
+
+If optional 5th argument CHILDFIRSTP is non-nil, then
+the function is called for each node after it has been
+called for that node's children.
+
+Optional 6th argument DEPTH limits how deeply to recurse.
+
+This function encompasses all the following Gtk functions:
+
+void gtk_ctree_post_recursive                    (GtkCTree     *ctree, 
+                                                 GtkCTreeNode *node,
+                                                 GtkCTreeFunc  func,
+                                                 gpointer      data);
+void gtk_ctree_post_recursive_to_depth           (GtkCTree     *ctree, 
+                                                 GtkCTreeNode *node,
+                                                 gint          depth,
+                                                 GtkCTreeFunc  func,
+                                                 gpointer      data);
+void gtk_ctree_pre_recursive                     (GtkCTree     *ctree, 
+                                                 GtkCTreeNode *node,
+                                                 GtkCTreeFunc  func,
+                                                 gpointer      data);
+void gtk_ctree_pre_recursive_to_depth            (GtkCTree     *ctree, 
+                                                 GtkCTreeNode *node,
+                                                 gint          depth,
+                                                 GtkCTreeFunc  func,
+                                                 gpointer      data);
+*/
+       (ctree, node, func, data, childfirstp, depth))
+{
+  struct gcpro gcpro1, gcpro2, gcpro3;
+  Lisp_Object closure = Qnil;
+
+  CHECK_GTK_OBJECT (ctree);
+
+  if (!NILP (node))
+    {
+      CHECK_GTK_BOXED (node);
+    }
+
+  if (!NILP (depth))
+    {
+      CHECK_INT (depth);
+    }
+
+  closure = Fcons (func, data);
+
+  GCPRO3 (ctree, node, closure);
+
+  if (NILP (depth))
+    {
+      (NILP (childfirstp) ? gtk_ctree_post_recursive : gtk_ctree_pre_recursive)
+       (GTK_CTREE (XGTK_OBJECT (ctree)->object),
+        NILP (node) ? NULL : (GtkCTreeNode *) XGTK_BOXED (node)->object,
+        __emacs_gtk_ctree_recurse_internal,
+        LISP_TO_VOID (closure));
+    }
+  else
+    {
+      (NILP (childfirstp) ? gtk_ctree_post_recursive_to_depth : gtk_ctree_pre_recursive_to_depth)
+       (GTK_CTREE (XGTK_OBJECT (ctree)->object),
+        NILP (node) ? NULL : (GtkCTreeNode *) XGTK_BOXED (node)->object,
+        XINT (depth),
+        __emacs_gtk_ctree_recurse_internal,
+        LISP_TO_VOID (closure));
+    }
+
+  UNGCPRO;
+  return (Qnil);
+}
+
+void syms_of_ui_byhand (void)
+{
+  DEFSUBR (Fgtk_toolbar_append_item);
+  DEFSUBR (Fgtk_toolbar_insert_item);
+  DEFSUBR (Fgtk_toolbar_prepend_item);
+  DEFSUBR (Fgtk_box_query_child_packing);
+  DEFSUBR (Fgtk_button_box_get_child_size_default);
+  DEFSUBR (Fgtk_button_box_get_child_ipadding_default);
+  DEFSUBR (Fgtk_button_box_get_child_size);
+  DEFSUBR (Fgtk_button_box_get_child_ipadding);
+  DEFSUBR (Fgtk_calendar_get_date);
+  DEFSUBR (Fgtk_clist_get_text);
+  DEFSUBR (Fgtk_clist_get_selection);
+  DEFSUBR (Fgtk_clist_get_pixmap);
+  DEFSUBR (Fgtk_clist_get_pixtext);
+  DEFSUBR (Fgtk_color_selection_get_color);
+  DEFSUBR (Fgtk_editable_insert_text);
+  DEFSUBR (Fgtk_pixmap_get);
+  DEFSUBR (Fgtk_curve_get_vector);
+  DEFSUBR (Fgtk_curve_set_vector);
+  DEFSUBR (Fgtk_label_get);
+  DEFSUBR (Fgtk_notebook_query_tab_label_packing);
+  DEFSUBR (Fgtk_widget_get_pointer);
+  DEFSUBR (Fgtk_ctree_recurse);
+}

diff --git a/src/ui-gtk.c b/src/ui-gtk.c
new file mode 100644 (file)
index 0000000..c7ddd3e
--- /dev/null
+++ b/src/ui-gtk.c
@@ -0,0 +1,1903 @@
+/* ui-gtk.c
+**
+** Description: Creating 'real' UIs from lisp.
+**
+** Created by: William M. Perry <wmperry@gnu.org>
+** Copyright (c) 2000 William M. Perry <wmperry@gnu.org>
+**
+*/
+
+#include <config.h>
+#include "lisp.h"
+#include "buffer.h"
+#include "console-gtk.h"
+#include "device.h"
+#include "window.h"
+#include "glyphs-gtk.h"
+#include "objects-gtk.h"
+#include "ui-gtk.h"
+#include "faces.h"
+#include "gui-gtk.h"
+#include "sysdll.h"
+#include "hash.h"
+#include "events.h"
+#include "elhash.h"
+
+/* XEmacs specific GTK types */
+#include "gtk-glue.c"
+
+Lisp_Object Qemacs_ffip;
+Lisp_Object Qemacs_gtk_objectp;
+Lisp_Object Qemacs_gtk_boxedp;
+Lisp_Object Qvoid;
+Lisp_Object Venumeration_info;
+
+static GHashTable *dll_cache;
+
+Lisp_Object gtk_type_to_lisp (GtkArg *arg);
+int lisp_to_gtk_type (Lisp_Object obj, GtkArg *arg);
+void describe_gtk_arg (GtkArg *arg);
+guint symbol_to_enum (Lisp_Object obj, GtkType t);
+static guint lisp_to_flag (Lisp_Object obj, GtkType t);
+static Lisp_Object flags_to_list (guint value, GtkType t);
+static Lisp_Object enum_to_symbol (guint value, GtkType t);
+
+#define NIL_OR_VOID_P(x) (NILP (x) || EQ (x, Qvoid))
+
+static void
+initialize_dll_cache (void)
+{
+  if (!dll_cache)
+    {
+      dll_cache = g_hash_table_new (g_str_hash, g_str_equal);
+
+      g_hash_table_insert (dll_cache, "---XEmacs Internal Handle---", dll_open (NULL));
+    }
+}
+
+DEFUN ("dll-load", Fdll_load, 1, 1, 0, /*
+Load a shared library DLL into XEmacs.  No initialization routines are required.
+This is for loading dependency DLLs into XEmacs.
+*/
+       (dll))
+{
+  dll_handle h;
+
+  CHECK_STRING (dll);
+
+  initialize_dll_cache ();
+
+  /* If the dll name has a directory component in it, then we should
+     expand it. */
+  if (!NILP (Fstring_match (build_string ("/"), dll, Qnil, Qnil)))
+    dll = Fexpand_file_name (dll, Qnil);
+
+  /* Check if we have already opened it first */
+  h = g_hash_table_lookup (dll_cache, XSTRING_DATA (dll));
+
+  if (!h)
+    {
+      h = dll_open ((char *) XSTRING_DATA (dll));
+
+      if (h)
+       {
+         g_hash_table_insert (dll_cache, g_strdup (XSTRING_DATA (dll)), h);
+       }
+      else
+       {
+         signal_simple_error ("dll_open error", build_string (dll_error (NULL)));
+       }
+    }
+  return (h ? Qt : Qnil);
+}
+
+\f
+/* Gtk object importing */
+EXFUN (Fgtk_import_type, 1);
+
+static struct hash_table *internal_type_hash;
+
+static int
+type_hash_equal(const void *arg1, const void *arg2)
+{
+  return ((GtkType) arg1 == (GtkType) arg2);
+}
+
+static unsigned long
+type_hash_hash(const void *arg)
+{
+  return ((unsigned long) arg);
+}
+
+static int
+type_already_imported_p (GtkType t)
+{
+  void *retval = NULL;
+
+  /* These are cases that we don't need to import */
+  switch (GTK_FUNDAMENTAL_TYPE (t))
+    {
+    case GTK_TYPE_CHAR:
+    case GTK_TYPE_UCHAR:
+    case GTK_TYPE_BOOL:
+    case GTK_TYPE_INT:
+    case GTK_TYPE_UINT:
+    case GTK_TYPE_LONG:
+    case GTK_TYPE_ULONG:
+    case GTK_TYPE_FLOAT:
+    case GTK_TYPE_DOUBLE:
+    case GTK_TYPE_STRING:
+    case GTK_TYPE_BOXED:
+    case GTK_TYPE_POINTER:
+    case GTK_TYPE_SIGNAL:
+    case GTK_TYPE_ARGS:
+    case GTK_TYPE_CALLBACK:
+    case GTK_TYPE_C_CALLBACK:
+    case GTK_TYPE_FOREIGN:
+       return (1);
+    }
+
+  if (!internal_type_hash)
+    {
+      internal_type_hash = make_general_hash_table (163, type_hash_hash, type_hash_equal);
+      return (0);
+    }
+
+  if (gethash ((void *)t, internal_type_hash, (const void **)&retval))
+    {
+      return (1);
+    }
+  return (0);
+}
+
+static void
+mark_type_as_imported (GtkType t)
+{
+  if (type_already_imported_p (t))
+    return;
+
+  puthash ((void *) t, (void *) 1, internal_type_hash);
+}
+
+static void import_gtk_type (GtkType t);
+
+static void
+import_gtk_object_internal (GtkType the_type)
+{
+  GtkType original_type = the_type;
+  int first_time = 1;
+
+  do
+    {
+      GtkArg *args;
+      guint32 *flags;
+      guint n_args;
+      guint i;
+#if 0
+      GtkObjectClass *klass;
+      GtkSignalQuery *query;
+      guint32 *signals;
+      guint n_signals;
+#endif
+
+      /* Register the type before we do anything else with it... */
+      if (!first_time)
+       {
+         if (!type_already_imported_p (the_type))
+           {
+             import_gtk_type (the_type);
+           }
+       }
+      else
+       {
+         /* We need to mark the object type as imported here or we
+            run the risk of SERIOUS recursion when we do automatic
+            argument type importing.  mark_type_as_imported() is
+            smart enough to be a noop if we attempt to register
+            things twice.  */
+         first_time = 0;
+         mark_type_as_imported (the_type);
+       }
+
+      args = gtk_object_query_args(the_type,&flags,&n_args);
+
+      /* First get the arguments the object can accept */
+      for (i = 0; i < n_args; i++)
+       {
+         if ((args[i].type != original_type) && !type_already_imported_p (args[i].type))
+           {
+             import_gtk_type (args[i].type);
+           }
+       }
+
+      g_free(args);
+      g_free(flags);
+
+#if 0
+      /* Now lets publish the signals */
+      klass = (GtkObjectClass *) gtk_type_class (the_type);
+      signals = klass->signals;
+      n_signals = klass->nsignals;
+
+      for (i = 0; i < n_signals; i++)
+       {
+         query = gtk_signal_query (signals[i]);
+         /* What do we want to do here? */
+         g_free (query);
+       }
+#endif
+
+      the_type = gtk_type_parent(the_type);
+    } while (the_type != GTK_TYPE_INVALID);
+}
+
+static void
+import_gtk_enumeration_internal (GtkType the_type)
+{
+  GtkEnumValue *vals = gtk_type_enum_get_values (the_type);
+  Lisp_Object assoc = Qnil;
+
+  if (NILP (Venumeration_info))
+    {
+      Venumeration_info = call2 (intern ("make-hashtable"), make_int (100), Qequal);
+    }
+  
+  while (vals && vals->value_name)
+    {
+      assoc = Fcons (Fcons (intern (vals->value_nick), make_int (vals->value)), assoc);
+      assoc = Fcons (Fcons (intern (vals->value_name), make_int (vals->value)), assoc);
+      vals++;
+    }
+
+  assoc = Fnreverse (assoc);
+
+  Fputhash (make_int (the_type), assoc, Venumeration_info);
+}
+
+static void
+import_gtk_type (GtkType t)
+{
+  if (type_already_imported_p (t))
+    {
+      return;
+    }
+
+  switch (GTK_FUNDAMENTAL_TYPE (t))
+    {
+    case GTK_TYPE_ENUM:
+    case GTK_TYPE_FLAGS:
+      import_gtk_enumeration_internal (t);
+      break;
+    case GTK_TYPE_OBJECT:
+      import_gtk_object_internal (t);
+      break;
+    default:
+      break;
+    }
+
+  mark_type_as_imported (t);
+}
+
+\f
+/* Foreign function calls */
+static emacs_ffi_data *
+allocate_ffi_data (void)
+{
+  emacs_ffi_data *data = alloc_lcrecord_type (emacs_ffi_data, &lrecord_emacs_ffi);
+
+  data->return_type = GTK_TYPE_NONE;
+  data->n_args = 0;
+  data->function_name = Qnil;
+  data->function_ptr = 0;
+  data->marshal = 0;
+
+  return (data);
+}
+
+static Lisp_Object
+mark_ffi_data (Lisp_Object obj)
+{
+  emacs_ffi_data *data = (emacs_ffi_data *) XFFI (obj);
+
+  mark_object (data->function_name);
+  return (Qnil);
+}
+
+static void
+ffi_object_printer (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+  char buf[200];
+
+  if (print_readably)
+    error ("printing unreadable object #<ffi %p", XFFI (obj)->function_ptr);
+
+  write_c_string ("#<ffi ", printcharfun);
+  print_internal (XFFI (obj)->function_name, printcharfun, 1);
+  if (XFFI (obj)->n_args)
+    {
+      sprintf (buf, " %d arguments", XFFI (obj)->n_args);
+      write_c_string (buf, printcharfun);
+    }
+  sprintf (buf, " %p>", (void *)XFFI (obj)->function_ptr);
+  write_c_string (buf, printcharfun);
+}
+
+DEFINE_LRECORD_IMPLEMENTATION ("ffi", emacs_ffi,
+                              mark_ffi_data, ffi_object_printer,
+                              0, 0, 0, NULL, emacs_ffi_data);
+
+typedef GtkObject * (*__OBJECT_fn) ();
+typedef gint (*__INT_fn) ();
+typedef void (*__NONE_fn) ();
+typedef gchar * (*__STRING_fn) ();
+typedef gboolean (*__BOOL_fn) ();
+typedef gfloat (*__FLOAT_fn) ();
+typedef void * (*__POINTER_fn) ();
+typedef GList * (*__LIST_fn) ();
+
+/* An auto-generated file of marshalling functions. */
+#include "emacs-marshals.c"
+
+#define CONVERT_SINGLE_TYPE(var,nam,tp) case GTK_TYPE_##nam: GTK_VALUE_##nam (var) = * (tp *) v; break;
+#define CONVERT_RETVAL(a,freep)                        \
+  do {                                                 \
+    void *v = GTK_VALUE_POINTER(a);                    \
+    switch (GTK_FUNDAMENTAL_TYPE (a.type))             \
+    {                                                  \
+       CONVERT_SINGLE_TYPE(a,CHAR,gchar);              \
+       CONVERT_SINGLE_TYPE(a,UCHAR,guchar);            \
+       CONVERT_SINGLE_TYPE(a,BOOL,gboolean);           \
+       CONVERT_SINGLE_TYPE(a,INT,gint);                \
+       CONVERT_SINGLE_TYPE(a,UINT,guint);              \
+       CONVERT_SINGLE_TYPE(a,LONG,glong);              \
+       CONVERT_SINGLE_TYPE(a,ULONG,gulong);            \
+       CONVERT_SINGLE_TYPE(a,FLOAT,gfloat);            \
+       CONVERT_SINGLE_TYPE(a,DOUBLE,gdouble);          \
+       CONVERT_SINGLE_TYPE(a,STRING,gchar *);          \
+       CONVERT_SINGLE_TYPE(a,ENUM,gint);               \
+       CONVERT_SINGLE_TYPE(a,FLAGS,guint);             \
+       CONVERT_SINGLE_TYPE(a,BOXED,void *);            \
+       CONVERT_SINGLE_TYPE(a,POINTER,void *);          \
+       CONVERT_SINGLE_TYPE(a,OBJECT,GtkObject *);      \
+       default:                                        \
+       GTK_VALUE_POINTER (a) = * (void **) v;  \
+       break;                                          \
+    }                                                  \
+    if (freep) xfree(v);                               \
+  } while (0)
+
+gpointer __allocate_object_storage (GtkType t)
+{
+  size_t s = 0;
+  void *rval = NULL;
+
+  switch (GTK_FUNDAMENTAL_TYPE (t))
+    {
+      /* flag types */
+    case GTK_TYPE_CHAR:
+      s = (sizeof (gchar));
+      break;
+    case GTK_TYPE_UCHAR:
+      s = (sizeof (guchar));
+      break;
+    case GTK_TYPE_BOOL:
+      s = (sizeof (gboolean));
+      break;
+    case GTK_TYPE_INT:
+      s = (sizeof (gint));
+      break;
+    case GTK_TYPE_UINT:
+      s = (sizeof (guint));
+      break;
+    case GTK_TYPE_LONG:
+      s = (sizeof (glong));
+      break;
+    case GTK_TYPE_ULONG:
+      s = (sizeof (gulong));
+      break;
+    case GTK_TYPE_FLOAT:
+      s = (sizeof (gfloat));
+      break;
+    case GTK_TYPE_DOUBLE:
+      s = (sizeof (gdouble));
+      break;
+    case GTK_TYPE_STRING:
+      s = (sizeof (gchar *));
+      break;
+    case GTK_TYPE_ENUM:
+    case GTK_TYPE_FLAGS:
+      s = (sizeof (guint));
+      break;
+    case GTK_TYPE_BOXED:
+    case GTK_TYPE_POINTER:
+      s = (sizeof (void *));
+      break;
+
+      /* base type of the object system */
+    case GTK_TYPE_OBJECT:
+      s = (sizeof (GtkObject *));
+      break;
+
+    default:
+      if (GTK_FUNDAMENTAL_TYPE (t) == GTK_TYPE_LISTOF)
+       {
+         s = (sizeof (void *));
+       }
+      rval = NULL;
+      break;
+    }
+
+  if (s)
+    {
+      rval = xmalloc (s);
+      memset (rval, '\0', s);
+    }
+
+  return (rval);
+}
+
+Lisp_Object type_to_marshaller_type (GtkType t)
+{
+  switch (GTK_FUNDAMENTAL_TYPE (t))
+    {
+    case GTK_TYPE_NONE:
+      return (build_string ("NONE"));
+      /* flag types */
+    case GTK_TYPE_CHAR:
+    case GTK_TYPE_UCHAR:
+      return (build_string ("CHAR"));
+    case GTK_TYPE_BOOL:
+      return (build_string ("BOOL"));
+    case GTK_TYPE_ENUM:
+    case GTK_TYPE_FLAGS:
+    case GTK_TYPE_INT:
+    case GTK_TYPE_UINT:
+      return (build_string ("INT"));
+    case GTK_TYPE_LONG:
+    case GTK_TYPE_ULONG:
+      return (build_string ("LONG"));
+    case GTK_TYPE_FLOAT:
+    case GTK_TYPE_DOUBLE:
+      return (build_string ("FLOAT"));
+    case GTK_TYPE_STRING:
+      return (build_string ("STRING"));
+    case GTK_TYPE_BOXED:
+    case GTK_TYPE_POINTER:
+      return (build_string ("POINTER"));
+    case GTK_TYPE_OBJECT:
+      return (build_string ("OBJECT"));
+    case GTK_TYPE_CALLBACK:
+      return (build_string ("CALLBACK"));
+    default:
+      /* I can't put this in the main switch statement because it is a
+         new fundamental type that is not fixed at compile time.
+         *sigh*
+        */
+      if (GTK_FUNDAMENTAL_TYPE (t) == GTK_TYPE_ARRAY)
+       return (build_string ("ARRAY"));
+
+      if (GTK_FUNDAMENTAL_TYPE (t) == GTK_TYPE_LISTOF)
+       return (build_string ("LIST"));
+      return (Qnil);
+    }
+}
+
+struct __dll_mapper_closure {
+  void * (*func) (dll_handle, const char *);
+  const char *obj_name;
+  void **storage;
+};
+
+static void __dll_mapper (gpointer key, gpointer value, gpointer user_data)
+{
+  struct __dll_mapper_closure *closure = (struct __dll_mapper_closure *) user_data;
+
+  if (*(closure->storage) == NULL)
+    {
+      /* Need to see if it is in this one */
+      *(closure->storage) = closure->func ((dll_handle) value, closure->obj_name);
+    }
+}
+
+DEFUN ("gtk-import-variable-internal", Fgtk_import_variable_internal, 2, 2, 0, /*
+Import a variable into the XEmacs namespace.
+*/
+       (type, name))
+{
+  void *var = NULL;
+  GtkArg arg;
+
+  if (SYMBOLP (type)) type = Fsymbol_name (type);
+
+  CHECK_STRING (type);
+  CHECK_STRING (name);
+
+  initialize_dll_cache ();
+  xemacs_init_gtk_classes ();
+
+  arg.type = gtk_type_from_name ((char *) XSTRING_DATA (type));
+
+  if (arg.type == GTK_TYPE_INVALID)
+    {
+      signal_simple_error ("Unknown type", type);
+    }
+
+  /* Need to look thru the already-loaded dlls */
+  {
+    struct __dll_mapper_closure closure;
+
+    closure.func = dll_variable;
+    closure.obj_name = XSTRING_DATA (name);
+    closure.storage = &var;
+
+    g_hash_table_foreach (dll_cache, __dll_mapper, &closure);
+  }
+
+  if (!var)
+    {
+      signal_simple_error ("Could not locate variable", name);
+    }
+
+  GTK_VALUE_POINTER(arg) = var;
+  CONVERT_RETVAL (arg, 0);
+  return (gtk_type_to_lisp (&arg));
+}
+
+DEFUN ("gtk-import-function-internal", Fgtk_import_function_internal, 2, 3, 0, /*
+Import a function into the XEmacs namespace.
+*/
+       (rettype, name, args))
+{
+  Lisp_Object rval = Qnil;
+  Lisp_Object marshaller = Qnil;
+  emacs_ffi_data *data = NULL;
+  gint n_args = 0;
+#if 0
+  dll_handle h = NULL;
+#endif
+  ffi_marshalling_function marshaller_func = NULL;
+  ffi_actual_function name_func = NULL;
+
+  CHECK_SYMBOL (rettype);
+  CHECK_STRING (name);
+  CHECK_LIST (args);
+
+  initialize_dll_cache ();
+  xemacs_init_gtk_classes ();
+
+  /* Need to look thru the already-loaded dlls */
+  {
+    struct __dll_mapper_closure closure;
+
+    closure.func = dll_function;
+    closure.obj_name = XSTRING_DATA (name);
+    closure.storage = (void **) &name_func;
+
+    g_hash_table_foreach (dll_cache, __dll_mapper, &closure);
+  }
+
+  if (!name_func)
+    {
+      signal_simple_error ("Could not locate function", name);
+    }
+
+  data = allocate_ffi_data ();
+
+  if (NILP (rettype))
+    {
+      rettype = Qvoid;
+    }
+
+  if (!NILP (args))
+    {
+      Lisp_Object tail = Qnil;
+      Lisp_Object value = args;
+      Lisp_Object type = Qnil;
+
+      EXTERNAL_LIST_LOOP (tail, value)
+       {
+         GtkType the_type;
+         Lisp_Object marshaller_type = Qnil;
+
+         CHECK_SYMBOL (XCAR (tail));
+
+         type = Fsymbol_name (XCAR (tail));
+
+         the_type = gtk_type_from_name ((char *) XSTRING_DATA (type));
+
+         if (the_type == GTK_TYPE_INVALID)
+           {
+             signal_simple_error ("Unknown argument type", type);
+           }
+
+         /* All things must be reduced to their basest form... */
+         import_gtk_type (the_type);
+         data->args[n_args] = the_type; /* GTK_FUNDAMENTAL_TYPE (the_type); */
+
+         /* Now lets build up another chunk of our marshaller function name */
+         marshaller_type = type_to_marshaller_type (data->args[n_args]);
+
+         if (NILP (marshaller_type))
+           {
+             signal_simple_error ("Do not know how to marshal", type);
+           }
+         marshaller = concat3 (marshaller, build_string ("_"), marshaller_type);
+         n_args++;
+       }
+    }
+  else
+    {
+      marshaller = concat3 (marshaller, build_string ("_"), type_to_marshaller_type (GTK_TYPE_NONE));
+    }
+
+  rettype = Fsymbol_name (rettype);
+  data->return_type = gtk_type_from_name ((char *) XSTRING_DATA (rettype));
+
+  if (data->return_type == GTK_TYPE_INVALID)
+    {
+      signal_simple_error ("Unknown return type", rettype);
+    }
+
+  import_gtk_type (data->return_type);
+
+  marshaller = concat3 (type_to_marshaller_type (data->return_type), build_string ("_"), marshaller);
+  marshaller = concat2 (build_string ("emacs_gtk_marshal_"), marshaller);
+
+  marshaller_func = (ffi_marshalling_function) find_marshaller ((char *) XSTRING_DATA (marshaller));
+
+  if (!marshaller_func)
+    {
+      signal_simple_error ("Could not locate marshaller function", marshaller);
+    }
+
+  data->n_args = n_args;
+  data->function_name = name;
+  data->function_ptr = name_func;
+  data->marshal = marshaller_func;
+
+  XSETFFI (rval, data);
+  return (rval);
+}
+
+DEFUN ("gtk-call-function", Fgtk_call_function, 1, 2, 0, /*
+Call an external function.
+*/
+       (func, args))
+{
+  GtkArg the_args[MAX_GTK_ARGS];
+  gint n_args = 0;
+  Lisp_Object retval = Qnil;
+
+  CHECK_FFI (func);
+  CHECK_LIST (args);
+
+  n_args = XINT (Flength (args));
+
+#ifdef XEMACS_IS_SMARTER_THAN_THE_PROGRAMMER
+  /* #### I think this is too dangerous to enable by default.
+  ** #### Genuine program bugs would probably be allowed to
+  ** #### slip by, and not be very easy to find.
+  ** #### Bill Perry July 9, 2000
+  */
+  if (n_args != XFFI(func)->n_args)
+    {
+      Lisp_Object for_append[3];
+
+      /* Signal an error if they pass in too many arguments */
+      if (n_args > XFFI(func)->n_args)
+       {
+         return Fsignal (Qwrong_number_of_arguments,
+                         list2 (func, make_int (n_args)));
+       }
+
+      /* If they did not provide enough arguments, be nice and assume
+      ** they wanted `nil' in there.
+      */
+      for_append[0] = args;
+      for_append[1] = Fmake_list (make_int (XFFI(func)->n_args - n_args), Qnil);
+
+      args = Fappend (2, for_append);
+    }
+#else
+  if (n_args != XFFI(func)->n_args)
+    {
+      /* Signal an error if they do not pass in the correct # of arguments */
+      return Fsignal (Qwrong_number_of_arguments,
+                     list2 (func, make_int (n_args)));
+    }
+#endif
+
+  if (!NILP (args))
+    {
+      Lisp_Object tail = Qnil;
+      Lisp_Object value = args;
+      
+      CHECK_LIST (args);
+      n_args = 0;
+
+      /* First we convert all of the arguments from Lisp to GtkArgs */
+      EXTERNAL_LIST_LOOP (tail, value)
+       {
+         the_args[n_args].type = XFFI (func)->args[n_args];
+
+         if (lisp_to_gtk_type (XCAR (tail), &the_args[n_args]))
+           {
+             /* There was some sort of an error */
+             signal_simple_error ("Error converting arguments", args);
+           }
+         n_args++;
+       }
+    }
+
+  /* Now we need to tack on space for a return value, if they have
+     asked for one */
+  if (XFFI (func)->return_type != GTK_TYPE_NONE)
+    {
+      the_args[n_args].type = XFFI (func)->return_type;
+      GTK_VALUE_POINTER (the_args[n_args]) = __allocate_object_storage (the_args[n_args].type);
+      n_args++;
+    }
+
+  XFFI (func)->marshal ((ffi_actual_function) (XFFI (func)->function_ptr), the_args);
+
+  if (XFFI (func)->return_type != GTK_TYPE_NONE)
+    {
+      CONVERT_RETVAL (the_args[n_args - 1], 1);
+      retval = gtk_type_to_lisp (&the_args[n_args - 1]);
+    }
+
+  /* Need to free any array or list pointers */
+  {
+    int i;
+    for (i = 0; i < n_args; i++)
+      {
+       if (GTK_FUNDAMENTAL_TYPE (the_args[i].type) == GTK_TYPE_ARRAY)
+         {
+           g_free (GTK_VALUE_POINTER (the_args[i]));
+         }
+       else if (GTK_FUNDAMENTAL_TYPE (the_args[i].type) == GTK_TYPE_LISTOF)
+         {
+           /* g_list_free (GTK_VALUE_POINTER (the_args[i])); */
+         }
+      }
+  }
+
+  return (retval);
+}
+
+\f
+
+/* GtkObject wrapping for Lisp */
+static void
+emacs_gtk_object_printer (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+  char buf[200];
+
+  if (print_readably)
+    error ("printing unreadable object #<GtkObject %p>", XGTK_OBJECT (obj)->object);
+
+  write_c_string ("#<GtkObject (", printcharfun);
+  if (XGTK_OBJECT (obj)->alive_p)
+    write_c_string (gtk_type_name (GTK_OBJECT_TYPE (XGTK_OBJECT (obj)->object)), printcharfun);
+  else
+    write_c_string ("dead", printcharfun);
+  sprintf (buf, ") %p>", (void *) XGTK_OBJECT (obj)->object);
+  write_c_string (buf, printcharfun);
+}
+
+static Lisp_Object
+object_getprop (Lisp_Object obj, Lisp_Object prop)
+{
+  Lisp_Object rval = Qnil;
+  Lisp_Object prop_name = Qnil;
+  GtkArgInfo *info = NULL;
+  char *err;
+  GtkArg args[2];
+
+  CHECK_SYMBOL (prop);         /* Shouldn't need to ever do this, but I'm paranoid */
+
+  prop_name = Fsymbol_name (prop);
+
+  args[0].name = (char *) XSTRING_DATA (prop_name);
+
+  err = gtk_object_arg_get_info (GTK_OBJECT_TYPE (XGTK_OBJECT (obj)->object),
+                                args[0].name,
+                                &info);
+
+  if (err)
+    {
+      /* Not a magic symbol, fall back to just looking in our real plist */
+      g_free (err);
+
+      return (Fplist_get (XGTK_OBJECT (obj)->plist, prop, Qunbound));
+    }
+
+  if (!(info->arg_flags & GTK_ARG_READABLE))
+    {
+      signal_simple_error ("Attempt to get write-only property", prop);
+    }
+
+  gtk_object_getv (XGTK_OBJECT (obj)->object, 1, args);
+
+  if (args[0].type == GTK_TYPE_INVALID)
+    {
+      /* If we can't get the attribute, then let the code in Fget know
+         so it can use the default value supplied by the caller */
+      return (Qunbound);
+    }
+
+  rval = gtk_type_to_lisp (&args[0]);
+
+  /* Free up any memory.  According to the documentation and Havoc's
+     book, if the fundamental type of the returned value is
+     GTK_TYPE_STRING, GTK_TYPE_BOXED, or GTK_TYPE_ARGS, you are
+     responsible for freeing it. */
+  switch (GTK_FUNDAMENTAL_TYPE (args[0].type))
+    {
+    case GTK_TYPE_STRING:
+      g_free (GTK_VALUE_STRING (args[0]));
+      break;
+    case GTK_TYPE_BOXED:
+      g_free (GTK_VALUE_BOXED (args[0]));
+      break;
+    case GTK_TYPE_ARGS:
+      g_free (GTK_VALUE_ARGS (args[0]).args);
+    default:
+      break;
+    }
+
+  return (rval);
+}
+
+static int
+object_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
+{
+  GtkArgInfo *info = NULL;
+  Lisp_Object prop_name = Qnil;
+  GtkArg args[2];
+  char *err = NULL;
+
+  prop_name = Fsymbol_name (prop);
+
+  args[0].name = (char *) XSTRING_DATA (prop_name);
+
+  err = gtk_object_arg_get_info (GTK_OBJECT_TYPE (XGTK_OBJECT (obj)->object),
+                                args[0].name,
+                                &info);
+
+  if (err)
+    {
+      /* Not a magic symbol, fall back to just storing in our real plist */
+      g_free (err);
+
+      XGTK_OBJECT (obj)->plist = Fplist_put (XGTK_OBJECT (obj)->plist, prop, value);
+      return (1);
+    }
+
+  args[0].type = info->type;
+
+  if (lisp_to_gtk_type (value, &args[0]))
+    {
+      signal_simple_error ("Error converting to GtkType", value);
+    }
+
+  if (!(info->arg_flags & GTK_ARG_WRITABLE))
+    {
+      signal_simple_error ("Attemp to set read-only argument", prop);
+    }
+
+  gtk_object_setv (XGTK_OBJECT (obj)->object, 1, args);
+
+  return (1);
+}
+
+static Lisp_Object
+mark_gtk_object_data (Lisp_Object obj)
+{
+  return (XGTK_OBJECT (obj)->plist);
+}
+
+static void
+emacs_gtk_object_finalizer (void *header, int for_disksave)
+{
+  emacs_gtk_object_data *data = (emacs_gtk_object_data *) header;
+
+  if (for_disksave)
+    {
+      Lisp_Object obj;
+      XSETGTK_OBJECT (obj, data);
+
+      signal_simple_error
+       ("Can't dump an emacs containing GtkObject objects", obj);
+    }
+
+  if (data->alive_p)
+    {
+      gtk_object_unref (data->object);
+    }
+}
+
+DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("GtkObject", emacs_gtk_object,
+                                         mark_gtk_object_data, /* marker function */
+                                         emacs_gtk_object_printer, /* print function */
+                                         emacs_gtk_object_finalizer, /* finalizer */
+                                         0, /* equality */
+                                         0, /* hash */
+                                         NULL, /* desc */
+                                         object_getprop, /* get prop */
+                                         object_putprop, /* put prop */
+                                         0, /* rem prop */
+                                         0, /* plist */
+                                         emacs_gtk_object_data);
+
+static emacs_gtk_object_data *
+allocate_emacs_gtk_object_data (void)
+{
+  emacs_gtk_object_data *data = alloc_lcrecord_type (emacs_gtk_object_data,
+                                                    &lrecord_emacs_gtk_object);
+
+  data->object = NULL;
+  data->alive_p = FALSE;
+  data->plist = Qnil;
+
+  return (data);
+}
+
+/* We need to keep track of when the object is destroyed so that we
+   can mark it as dead, otherwise even our print routine (which calls
+   GTK_OBJECT_TYPE) will crap out and die.  This is also used in the
+   lisp_to_gtk_type() routine to defend against passing dead objects
+   to GTK routines. */
+static void
+__notice_object_destruction (GtkObject *obj, gpointer user_data)
+{
+  ungcpro_popup_callbacks ((GUI_ID) user_data);
+}
+
+Lisp_Object build_gtk_object (GtkObject *obj)
+{
+  Lisp_Object retval = Qnil;
+  emacs_gtk_object_data *data = NULL;
+  GUI_ID id = 0;
+
+  id = (GUI_ID) gtk_object_get_data (obj, "xemacs::gui_id");
+
+  if (id)
+    {
+      retval = get_gcpro_popup_callbacks (id);
+    }
+
+  if (NILP (retval))
+    {
+      data = allocate_emacs_gtk_object_data ();
+
+      data->object = obj;
+      data->alive_p = TRUE;
+      XSETGTK_OBJECT (retval, data);
+
+      id = new_gui_id ();
+      gtk_object_set_data (obj, "xemacs::gui_id", (gpointer) id);
+      gcpro_popup_callbacks (id, retval);
+      gtk_object_ref (obj);
+      gtk_signal_connect (obj, "destroy", GTK_SIGNAL_FUNC (__notice_object_destruction), (gpointer)id);
+    }
+
+  return (retval);
+}
+
+static void
+__internal_callback_destroy (gpointer data)
+{
+  Lisp_Object lisp_data;
+
+  VOID_TO_LISP (lisp_data, data);
+
+  ungcpro_popup_callbacks (XINT (XCAR (lisp_data)));
+}
+
+static void
+__internal_callback_marshal (GtkObject *obj, gpointer data, guint n_args, GtkArg *args)
+{
+  Lisp_Object arg_list = Qnil;
+  Lisp_Object callback_fn = Qnil;
+  Lisp_Object callback_data = Qnil;
+  Lisp_Object newargs[3];
+  Lisp_Object rval = Qnil;
+  struct gcpro gcpro1;
+  int i;
+
+  VOID_TO_LISP (callback_fn, data);
+
+  /* Nuke the GUI_ID off the front */
+  callback_fn = XCDR (callback_fn);
+
+  callback_data = XCAR (callback_fn);
+  callback_fn = XCDR (callback_fn);
+
+  /* The callback data goes at the very end of the argument list */
+  arg_list = Fcons (callback_data, Qnil);
+
+  /* Build up the argument list, lisp style */
+  for (i = n_args - 1; i >= 0; i--)
+    {
+      arg_list = Fcons (gtk_type_to_lisp (&args[i]), arg_list);
+    }
+
+  /* We always pass the widget as the first parameter at the very least */
+  arg_list = Fcons (build_gtk_object (obj), arg_list);
+
+  GCPRO1 ((arg_list));
+
+  newargs[0] = callback_fn;
+  newargs[1] = arg_list;
+
+  rval = Fapply (2, newargs);
+  signal_fake_event ();
+
+  if (args[n_args].type != GTK_TYPE_NONE)
+    lisp_to_gtk_type (rval, &args[n_args]);
+
+  UNGCPRO;
+}
+
+DEFUN ("gtk-signal-connect", Fgtk_signal_connect, 3, 6, 0, /*
+*/
+       (obj, name, func, cb_data, object_signal, after_p))
+{
+  int c_after;
+  int c_object_signal;
+  GUI_ID id = 0;
+
+  CHECK_GTK_OBJECT (obj);
+
+  if (SYMBOLP (name))
+    name = Fsymbol_name (name);
+
+  CHECK_STRING (name);
+
+  if (NILP (object_signal))
+    c_object_signal = 0;
+  else
+    c_object_signal = 1;
+
+  if (NILP (after_p))
+    c_after = 0;
+  else
+    c_after = 1;
+
+  id = new_gui_id ();
+  func = Fcons (cb_data, func);
+  func = Fcons (make_int (id), func);
+
+  gcpro_popup_callbacks (id, func);
+
+  gtk_signal_connect_full (XGTK_OBJECT (obj)->object, (char *) XSTRING_DATA (name),
+                          NULL, __internal_callback_marshal, LISP_TO_VOID (func),
+                          __internal_callback_destroy, c_object_signal, c_after);
+  return (Qt);
+}
+
+\f
+/* GTK_TYPE_BOXED wrapper for Emacs lisp */
+static void
+emacs_gtk_boxed_printer (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+  char buf[200];
+
+  if (print_readably)
+    error ("printing unreadable object #<GtkBoxed %p>", XGTK_BOXED (obj)->object);
+
+  write_c_string ("#<GtkBoxed (", printcharfun);
+  write_c_string (gtk_type_name (XGTK_BOXED (obj)->object_type), printcharfun);
+  sprintf (buf, ") %p>", (void *) XGTK_BOXED (obj)->object);
+  write_c_string (buf, printcharfun);
+}
+
+static int
+emacs_gtk_boxed_equality (Lisp_Object o1, Lisp_Object o2, int depth)
+{
+  emacs_gtk_boxed_data *data1 = XGTK_BOXED(o1);
+  emacs_gtk_boxed_data *data2 = XGTK_BOXED(o2);
+
+  return ((data1->object == data2->object) &&
+         (data1->object_type == data2->object_type));
+}
+
+static unsigned long
+emacs_gtk_boxed_hash (Lisp_Object obj, int depth)
+{
+  emacs_gtk_boxed_data *data = XGTK_BOXED(obj);
+  return (HASH2 ((unsigned long)data->object, data->object_type));
+}
+
+DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("GtkBoxed", emacs_gtk_boxed,
+                                         0, /* marker function */
+                                         emacs_gtk_boxed_printer, /* print function */
+                                         0, /* nuker */
+                                         emacs_gtk_boxed_equality, /* equality */
+                                         emacs_gtk_boxed_hash, /* hash */
+                                         NULL, /* desc */
+                                         0, /* get prop */
+                                         0, /* put prop */
+                                         0, /* rem prop */
+                                         0, /* plist */
+                                         emacs_gtk_boxed_data);
+
+/* Currently defined GTK_TYPE_BOXED structures are:
+
+   GtkAccelGroup -
+   GtkSelectionData -
+   GtkStyle -
+   GtkCTreeNode - 
+   GdkColormap -
+   GdkVisual -
+   GdkFont -
+   GdkWindow -
+   GdkDragContext -
+   GdkEvent -
+   GdkColor - 
+*/
+static emacs_gtk_boxed_data *
+allocate_emacs_gtk_boxed_data (void)
+{
+  emacs_gtk_boxed_data *data = alloc_lcrecord_type (emacs_gtk_boxed_data,
+                                                   &lrecord_emacs_gtk_boxed);
+
+  data->object = NULL;
+  data->object_type = GTK_TYPE_INVALID;
+
+  return (data);
+}
+
+Lisp_Object build_gtk_boxed (void *obj, GtkType t)
+{
+  Lisp_Object retval = Qnil;
+  emacs_gtk_boxed_data *data = NULL;
+
+  if (GTK_FUNDAMENTAL_TYPE (t) != GTK_TYPE_BOXED)
+    abort();
+
+  data = allocate_emacs_gtk_boxed_data ();
+  data->object = obj;
+  data->object_type = t;
+
+  XSETGTK_BOXED (retval, data);
+
+  return (retval);
+}
+
+\f
+/* The automatically generated structure access routines */
+#include "emacs-widget-accessors.c"
+
+/* The hand generated funky functions that we can't just import using the FFI */
+#include "ui-byhand.c"
+
+/* The glade support */
+#include "glade.c"
+
+\f
+/* Type manipulation */
+DEFUN ("gtk-fundamental-type", Fgtk_fundamental_type, 1, 1, 0, /*
+Load a shared library DLL into XEmacs.  No initialization routines are required.
+This is for loading dependency DLLs into XEmacs.
+*/
+       (type))
+{
+  GtkType t;
+
+  if (SYMBOLP (type))
+    type = Fsymbol_name (type);
+
+  CHECK_STRING (type);
+
+  t = gtk_type_from_name ((char *) XSTRING_DATA (type));
+
+  if (t == GTK_TYPE_INVALID)
+    {
+      signal_simple_error ("Not a GTK type", type);
+    }
+  return (make_int (GTK_FUNDAMENTAL_TYPE (t)));
+}
+
+DEFUN ("gtk-object-type", Fgtk_object_type, 1, 1, 0, /*
+Return the GtkType of OBJECT.
+*/
+       (object))
+{
+  CHECK_GTK_OBJECT (object);
+  return (make_int (GTK_OBJECT_TYPE (XGTK_OBJECT (object)->object)));
+}
+
+DEFUN ("gtk-describe-type", Fgtk_describe_type, 1, 1, 0, /*
+Returns a cons of two lists describing the Gtk object TYPE.
+The car is a list of all the signals that it will emit.
+The cdr is a list of all the magic properties it has.
+*/
+       (type))
+{
+  Lisp_Object rval, signals, props;
+  GtkType t;
+
+  props = signals = rval = Qnil;
+
+  if (SYMBOLP (type))
+    {
+      type = Fsymbol_name (type);
+    }
+
+  if (STRINGP (type))
+    {
+      t = gtk_type_from_name (XSTRING_DATA (type));
+      if (t == GTK_TYPE_INVALID)
+       {
+         signal_simple_error ("Not a GTK type", type);
+       }
+    }
+  else
+    {
+      CHECK_INT (type);
+      t = XINT (type);
+    }
+
+  if (GTK_FUNDAMENTAL_TYPE (t) != GTK_TYPE_OBJECT)
+    {
+      signal_simple_error ("Not a GtkObject", type);
+    }
+
+  /* Need to do stupid shit like this to get the args
+  ** registered... damn GTK and its lazy loading
+  */
+  {
+    GtkArg args[3];
+    GtkObject *obj = gtk_object_newv (t, 0, args);
+
+    gtk_object_destroy(obj);
+  }
+
+  do
+    {
+      guint i;
+
+      /* Do the magic arguments first */
+      {
+       GtkArg *args;
+       guint32 *flags;
+       guint n_args;
+
+       args = gtk_object_query_args(t,&flags,&n_args);
+
+       for (i = 0; i < n_args; i++)
+         {
+           props = Fcons (Fcons (intern (gtk_type_name(args[i].type)),
+                                 intern (args[i].name)), props);
+         }
+
+       g_free (args);
+       g_free (flags);
+      }
+
+      /* Now the signals */
+      {
+       GtkObjectClass *klass;
+       GtkSignalQuery *query;
+       guint32 *gtk_signals;
+       guint n_signals;
+
+       klass = (GtkObjectClass *) gtk_type_class (t);
+       gtk_signals = klass->signals;
+       n_signals = klass->nsignals;
+
+       for (i = 0; i < n_signals; i++)
+         {
+           Lisp_Object params = Qnil;
+
+           query = gtk_signal_query (gtk_signals[i]);
+
+           if (query)
+             {
+               if (query->nparams)
+                 {
+                   int j;
+
+                   for (j = query->nparams - 1; j >= 0; j--)
+                     {
+                       params = Fcons (intern (gtk_type_name (query->params[j])), params);
+                     }
+                 }
+
+               signals = Fcons (Fcons (intern (gtk_type_name (query->return_val)),
+                                       Fcons (intern (query->signal_name),
+                                              params)),
+                                signals);
+               
+               g_free (query);
+             }
+         }
+      }
+      t = gtk_type_parent(t);
+    } while (t != GTK_TYPE_INVALID);
+
+  rval = Fcons (signals, props);
+
+  return (rval);
+}
+
+\f
+void
+syms_of_ui_gtk (void)
+{
+  INIT_LRECORD_IMPLEMENTATION (emacs_ffi);
+  INIT_LRECORD_IMPLEMENTATION (emacs_gtk_object);
+  INIT_LRECORD_IMPLEMENTATION (emacs_gtk_boxed);
+  defsymbol (&Qemacs_ffip, "emacs-ffi-p");
+  defsymbol (&Qemacs_gtk_objectp, "emacs-gtk-object-p");
+  defsymbol (&Qemacs_gtk_boxedp, "emacs-gtk-boxed-p");
+  defsymbol (&Qvoid, "void");
+  DEFSUBR (Fdll_load);
+  DEFSUBR (Fgtk_import_function_internal);
+  DEFSUBR (Fgtk_import_variable_internal);
+  DEFSUBR (Fgtk_signal_connect);
+  DEFSUBR (Fgtk_call_function);
+  DEFSUBR (Fgtk_fundamental_type);
+  DEFSUBR (Fgtk_object_type);
+  DEFSUBR (Fgtk_describe_type);
+  syms_of_widget_accessors ();
+  syms_of_ui_byhand ();
+  syms_of_glade ();
+}
+
+void
+vars_of_ui_gtk (void)
+{
+  Fprovide (intern ("gtk-ui"));
+  DEFVAR_LISP ("gtk-enumeration-info", &Venumeration_info /*
+A hashtable holding type information about GTK enumerations and flags.
+Do NOT modify unless you really understand ui-gtk.c.
+*/);
+
+  Venumeration_info = Qnil;
+  vars_of_glade ();
+}
+
+\f
+/* Various utility functions */
+void describe_gtk_arg (GtkArg *arg)
+{
+  GtkArg a = *arg;
+
+  switch (GTK_FUNDAMENTAL_TYPE (a.type))
+    {
+      /* flag types */
+    case GTK_TYPE_CHAR:
+      stderr_out ("char: %c\n", GTK_VALUE_CHAR (a));
+      break;
+    case GTK_TYPE_UCHAR:
+      stderr_out ("uchar: %c\n", GTK_VALUE_CHAR (a));
+      break;
+    case GTK_TYPE_BOOL:
+      stderr_out ("uchar: %s\n", GTK_VALUE_BOOL (a) ? "true" : "false");
+      break;
+    case GTK_TYPE_INT:
+      stderr_out ("int: %d\n", GTK_VALUE_INT (a));
+      break;
+    case GTK_TYPE_UINT:
+      stderr_out ("uint: %du\n", GTK_VALUE_UINT (a));
+      break;
+    case GTK_TYPE_LONG:
+      stderr_out ("long: %ld\n", GTK_VALUE_LONG (a));
+      break;
+    case GTK_TYPE_ULONG:
+      stderr_out ("ulong: %lu\n", GTK_VALUE_ULONG (a));
+      break;
+    case GTK_TYPE_FLOAT:
+      stderr_out ("float: %g\n", GTK_VALUE_FLOAT (a));
+      break;
+    case GTK_TYPE_DOUBLE:
+      stderr_out ("double: %f\n", GTK_VALUE_DOUBLE (a));
+      break;
+    case GTK_TYPE_STRING:
+      stderr_out ("string: %s\n", GTK_VALUE_STRING (a));
+      break;
+    case GTK_TYPE_ENUM:
+    case GTK_TYPE_FLAGS:
+      stderr_out ("%s: ", (a.type == GTK_TYPE_ENUM) ? "enum" : "flag");
+      {
+       GtkEnumValue *vals = gtk_type_enum_get_values (a.type);
+
+       while (vals && vals->value_name && (vals->value != GTK_VALUE_ENUM(a))) vals++;
+
+       stderr_out ("%s\n", vals ? vals->value_name : "!!! UNKNOWN ENUM VALUE !!!");
+      }
+      break;
+    case GTK_TYPE_BOXED:
+      stderr_out ("boxed: %p\n", GTK_VALUE_BOXED (a));
+      break;
+    case GTK_TYPE_POINTER:
+      stderr_out ("pointer: %p\n", GTK_VALUE_BOXED (a));
+      break;
+
+      /* structured types */
+    case GTK_TYPE_SIGNAL:
+    case GTK_TYPE_ARGS: /* This we can do as a list of values */
+      abort();
+    case GTK_TYPE_CALLBACK:
+      stderr_out ("callback fn: ...\n");
+      break;
+    case GTK_TYPE_C_CALLBACK:
+    case GTK_TYPE_FOREIGN:
+      abort();
+
+      /* base type of the object system */
+    case GTK_TYPE_OBJECT:
+      if (GTK_VALUE_OBJECT (a))
+       stderr_out ("object: %s\n", gtk_type_name (GTK_OBJECT_TYPE (GTK_VALUE_OBJECT (a))));
+      else
+       stderr_out ("object: NULL\n");
+      break;
+
+    default:
+      abort();
+    }
+}
+
+Lisp_Object gtk_type_to_lisp (GtkArg *arg)
+{
+  switch (GTK_FUNDAMENTAL_TYPE (arg->type))
+    {
+    case GTK_TYPE_NONE:
+      return (Qnil);
+    case GTK_TYPE_CHAR:
+      return (make_char (GTK_VALUE_CHAR (*arg)));
+    case GTK_TYPE_UCHAR:
+      return (make_char (GTK_VALUE_UCHAR (*arg)));
+    case GTK_TYPE_BOOL:
+      return (GTK_VALUE_BOOL (*arg) ? Qt : Qnil);
+    case GTK_TYPE_INT:
+      return (make_int (GTK_VALUE_INT (*arg)));
+    case GTK_TYPE_UINT:
+      return (make_int (GTK_VALUE_INT (*arg)));
+    case GTK_TYPE_LONG:                /* I think these are wrong! */
+      return (make_int (GTK_VALUE_INT (*arg)));
+    case GTK_TYPE_ULONG:       /* I think these are wrong! */
+      return (make_int (GTK_VALUE_INT (*arg)));
+    case GTK_TYPE_FLOAT:
+      return (make_float (GTK_VALUE_FLOAT (*arg)));
+    case GTK_TYPE_DOUBLE:
+      return (make_float (GTK_VALUE_DOUBLE (*arg)));
+    case GTK_TYPE_STRING:
+      return (build_string (GTK_VALUE_STRING (*arg)));
+    case GTK_TYPE_FLAGS:
+      return (flags_to_list (GTK_VALUE_FLAGS (*arg), arg->type));
+    case GTK_TYPE_ENUM:
+      return (enum_to_symbol (GTK_VALUE_ENUM (*arg), arg->type));
+    case GTK_TYPE_BOXED:
+      if (arg->type == GTK_TYPE_GDK_EVENT)
+       {
+         return (gdk_event_to_emacs_event((GdkEvent *) GTK_VALUE_BOXED (*arg)));
+       }
+
+      if (GTK_VALUE_BOXED (*arg))
+       return (build_gtk_boxed (GTK_VALUE_BOXED (*arg), arg->type));
+      else
+       return (Qnil);
+    case GTK_TYPE_POINTER:
+      if (GTK_VALUE_POINTER (*arg))
+       {
+         Lisp_Object rval;
+         
+         VOID_TO_LISP (rval, GTK_VALUE_POINTER (*arg));
+         return (rval);
+       }
+      else
+       return (Qnil);
+    case GTK_TYPE_OBJECT:
+      if (GTK_VALUE_OBJECT (*arg))
+       return (build_gtk_object (GTK_VALUE_OBJECT (*arg)));
+      else
+       return (Qnil);
+
+    case GTK_TYPE_CALLBACK:
+      {
+       Lisp_Object rval;
+
+       VOID_TO_LISP (rval, GTK_VALUE_CALLBACK (*arg).data);
+
+       return (rval);
+      }
+
+    default:
+      if (GTK_FUNDAMENTAL_TYPE (arg->type) == GTK_TYPE_LISTOF)
+       {
+         if (!GTK_VALUE_POINTER (*arg))
+           return (Qnil);
+         else
+           {
+             return (xemacs_gtklist_to_list (arg));
+           }
+       }
+      stderr_out ("Do not know how to convert `%s' to lisp!\n", gtk_type_name (arg->type));
+      abort ();
+    }
+  /* This is chuck reminding GCC to... SHUT UP! */
+  return (Qnil);
+}
+
+int lisp_to_gtk_type (Lisp_Object obj, GtkArg *arg)
+{
+  switch (GTK_FUNDAMENTAL_TYPE (arg->type))
+    {
+      /* flag types */
+    case GTK_TYPE_NONE:
+      return (0);
+    case GTK_TYPE_CHAR:
+      {
+       Emchar c;
+
+       CHECK_CHAR_COERCE_INT (obj);
+       c = XCHAR (obj);
+       GTK_VALUE_CHAR (*arg) = c;
+      }
+      break;
+    case GTK_TYPE_UCHAR:
+      {
+       Emchar c;
+
+       CHECK_CHAR_COERCE_INT (obj);
+       c = XCHAR (obj);
+       GTK_VALUE_CHAR (*arg) = c;
+      }
+      break;
+    case GTK_TYPE_BOOL:
+      GTK_VALUE_BOOL (*arg) = NILP (obj) ? FALSE : TRUE;
+      break;
+    case GTK_TYPE_INT:
+    case GTK_TYPE_UINT:
+      if (NILP (obj) || EQ (Qt, obj))
+       {
+         /* For we are a kind mistress and allow sending t/nil for
+             1/0 to stupid GTK functions that say they take guint or
+             gint in the header files, but actually treat it like a
+             bool.  *sigh*
+         */
+         GTK_VALUE_INT(*arg) = NILP (obj) ? 0 : 1;
+       }
+      else
+       {
+         CHECK_INT (obj);
+         GTK_VALUE_INT(*arg) = XINT (obj);
+       }
+      break;
+    case GTK_TYPE_LONG:
+    case GTK_TYPE_ULONG:
+      abort();
+    case GTK_TYPE_FLOAT:
+      CHECK_INT_OR_FLOAT (obj);
+      GTK_VALUE_FLOAT(*arg) = extract_float (obj);
+      break;
+    case GTK_TYPE_DOUBLE:
+      CHECK_INT_OR_FLOAT (obj);
+      GTK_VALUE_DOUBLE(*arg) = extract_float (obj);
+      break;
+    case GTK_TYPE_STRING:
+      if (NILP (obj))
+       GTK_VALUE_STRING (*arg) = NULL;
+      else
+       {
+         CHECK_STRING (obj);
+         GTK_VALUE_STRING (*arg) = (char *) XSTRING_DATA (obj);
+       }
+      break;
+    case GTK_TYPE_ENUM:
+    case GTK_TYPE_FLAGS:
+      /* Convert a lisp symbol to a GTK enum */
+      GTK_VALUE_ENUM(*arg) = lisp_to_flag (obj, arg->type);
+      break;
+    case GTK_TYPE_BOXED:
+      if (NILP (obj))
+       {
+         GTK_VALUE_BOXED(*arg) = NULL;
+       }
+      else if (GTK_BOXEDP (obj))
+       {
+         GTK_VALUE_BOXED(*arg) = XGTK_BOXED (obj)->object;
+       }
+      else if (arg->type == GTK_TYPE_STYLE)
+       {
+         obj = Ffind_face (obj);
+         CHECK_FACE (obj);
+         GTK_VALUE_BOXED(*arg) = face_to_style (obj);
+       }
+      else if (arg->type == GTK_TYPE_GDK_GC)
+       {
+         obj = Ffind_face (obj);
+         CHECK_FACE (obj);
+         GTK_VALUE_BOXED(*arg) = face_to_gc (obj);
+       }
+      else if (arg->type == GTK_TYPE_GDK_WINDOW)
+       {
+         if (GLYPHP (obj))
+           {
+             Lisp_Object window = Fselected_window (Qnil);
+             Lisp_Object instance = glyph_image_instance (obj, window, ERROR_ME_NOT, 1);
+             struct Lisp_Image_Instance *p = XIMAGE_INSTANCE (instance);
+
+             switch (XIMAGE_INSTANCE_TYPE (instance))
+               {
+               case IMAGE_TEXT:
+               case IMAGE_POINTER:
+               case IMAGE_SUBWINDOW:
+               case IMAGE_NOTHING:
+                 GTK_VALUE_BOXED(*arg) = NULL;
+                 break;
+
+               case IMAGE_MONO_PIXMAP:
+               case IMAGE_COLOR_PIXMAP:
+                 GTK_VALUE_BOXED(*arg) = IMAGE_INSTANCE_GTK_PIXMAP (p);
+                 break;
+               }
+           }
+         else if (GTK_OBJECTP (obj) && GTK_IS_WIDGET (XGTK_OBJECT (obj)->object))
+           {
+             GTK_VALUE_BOXED(*arg) = GTK_WIDGET (XGTK_OBJECT (obj))->window;
+           }
+         else
+           {
+             signal_simple_error ("Don't know how to convert object to GDK_WINDOW", obj);
+           }
+         break;
+       }
+      else if (arg->type == GTK_TYPE_GDK_COLOR)
+       {
+         if (COLOR_SPECIFIERP (obj))
+           {
+             /* If it is a specifier, we just convert it to an
+                 instance, and let the ifs below handle it.
+             */
+             obj = Fspecifier_instance (obj, Qnil, Qnil, Qnil);
+           }
+         
+         if (COLOR_INSTANCEP (obj))
+           {
+             /* Easiest one */
+             GTK_VALUE_BOXED(*arg) = COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (obj));
+           }
+         else if (STRINGP (obj))
+           {
+             signal_simple_error ("Please use a color specifier or instance, not a string", obj);
+           }
+         else
+           {
+             signal_simple_error ("Don't know hot to convert to GdkColor", obj);
+           }
+       }
+      else if (arg->type == GTK_TYPE_GDK_FONT)
+       {
+         if (SYMBOLP (obj))
+           {
+             /* If it is a symbol, we treat that as a face name */
+             obj = Ffind_face (obj);
+           }
+
+         if (FACEP (obj))
+           {
+             /* If it is a face, we just grab the font specifier, and
+                 cascade down until we finally reach a FONT_INSTANCE
+             */
+             obj = Fget (obj, Qfont, Qnil);
+           }
+
+         if (FONT_SPECIFIERP (obj))
+           {
+             /* If it is a specifier, we just convert it to an
+                 instance, and let the ifs below handle it
+             */
+             obj = Fspecifier_instance (obj, Qnil, Qnil, Qnil);
+           }
+
+         if (FONT_INSTANCEP (obj))
+           {
+             /* Easiest one */
+             GTK_VALUE_BOXED(*arg) = FONT_INSTANCE_GTK_FONT (XFONT_INSTANCE (obj));
+           }
+         else if (STRINGP (obj))
+           {
+             signal_simple_error ("Please use a font specifier or instance, not a string", obj);
+           }
+         else
+           {
+             signal_simple_error ("Don't know hot to convert to GdkColor", obj);
+           }
+       }
+      else
+       {
+         /* Unknown type to convert to boxed */
+         stderr_out ("Don't know how to convert to boxed!\n");
+         GTK_VALUE_BOXED(*arg) = NULL;
+       }
+      break;
+
+    case GTK_TYPE_POINTER:
+      if (NILP (obj))
+       GTK_VALUE_POINTER(*arg) = NULL;
+      else
+       GTK_VALUE_POINTER(*arg) = LISP_TO_VOID (obj);
+      break;
+
+      /* structured types */
+    case GTK_TYPE_SIGNAL:
+    case GTK_TYPE_ARGS: /* This we can do as a list of values */
+    case GTK_TYPE_C_CALLBACK:
+    case GTK_TYPE_FOREIGN:
+      stderr_out ("Do not know how to convert `%s' from lisp!\n", gtk_type_name (arg->type));
+      return (-1);
+
+#if 0
+      /* #### BILL! */
+      /* This is not used, and does not work with union type */
+    case GTK_TYPE_CALLBACK:
+      {
+       GUI_ID id;
+
+       id = new_gui_id ();
+       obj = Fcons (Qnil, obj); /* Empty data */
+       obj = Fcons (make_int (id), obj);
+
+       gcpro_popup_callbacks (id, obj);
+
+       GTK_VALUE_CALLBACK(*arg).marshal = __internal_callback_marshal;
+       GTK_VALUE_CALLBACK(*arg).data = (gpointer) obj;
+       GTK_VALUE_CALLBACK(*arg).notify = __internal_callback_destroy;
+      }
+      break;
+#endif
+
+      /* base type of the object system */
+    case GTK_TYPE_OBJECT:
+      if (NILP (obj))
+       GTK_VALUE_OBJECT (*arg) = NULL;
+      else
+       {
+         CHECK_GTK_OBJECT (obj);
+         if (XGTK_OBJECT (obj)->alive_p)
+           GTK_VALUE_OBJECT (*arg) = XGTK_OBJECT (obj)->object;
+         else
+           signal_simple_error ("Attempting to pass dead object to GTK function", obj);
+       }
+      break;
+
+    default:
+      if (GTK_FUNDAMENTAL_TYPE (arg->type) == GTK_TYPE_ARRAY)
+       {
+         if (NILP (obj))
+           GTK_VALUE_POINTER(*arg) = NULL;
+         else
+           {
+             xemacs_list_to_array (obj, arg);
+           }
+       }
+      else if (GTK_FUNDAMENTAL_TYPE (arg->type) == GTK_TYPE_LISTOF)
+       {
+         if (NILP (obj))
+           GTK_VALUE_POINTER(*arg) = NULL;
+         else
+           {
+             xemacs_list_to_gtklist (obj, arg);
+           }
+       }
+      else
+       {
+         stderr_out ("Do not know how to convert `%s' from lisp!\n", gtk_type_name (arg->type));
+         abort();
+       }
+      break;
+    }
+
+  return (0);
+}
+
+/* This is used in glyphs-gtk.c as well */
+static Lisp_Object
+get_enumeration (GtkType t)
+{
+  Lisp_Object alist;
+
+  if (NILP (Venumeration_info))
+    {
+      Venumeration_info = call2 (intern ("make-hashtable"), make_int (100), Qequal);
+    }
+
+  alist = Fgethash (make_int (t), Venumeration_info, Qnil);  
+
+  if (NILP (alist))
+    {
+      import_gtk_enumeration_internal (t);
+      alist = Fgethash (make_int (t), Venumeration_info, Qnil);
+    }
+  return (alist);
+}
+
+guint
+symbol_to_enum (Lisp_Object obj, GtkType t)
+{
+  Lisp_Object alist = get_enumeration (t);
+  Lisp_Object value = Qnil;
+
+  if (NILP (alist))
+    {
+      signal_simple_error ("Unkown enumeration", build_string (gtk_type_name (t)));
+    }
+
+  value = Fassq (obj, alist);
+
+  if (NILP (value))
+    {
+      signal_simple_error ("Unknown value", obj);
+    }
+
+  CHECK_INT (XCDR (value));
+
+  return (XINT (XCDR (value)));
+}
+
+static guint
+lisp_to_flag (Lisp_Object obj, GtkType t)
+{
+  guint val = 0;
+
+  if (NILP (obj))
+    {
+      /* Do nothing */
+    }
+  else if (SYMBOLP (obj))
+    {
+      val = symbol_to_enum (obj, t);
+    }
+  else if (LISTP (obj))
+    {
+      while (!NILP (obj))
+       {
+         val |= symbol_to_enum (XCAR (obj), t);
+         obj = XCDR (obj);
+       }
+    }
+  else
+    {
+      /* abort ()? */
+    }
+  return (val);
+}
+
+static Lisp_Object
+flags_to_list (guint value, GtkType t)
+{
+  Lisp_Object rval = Qnil;
+  Lisp_Object alist = get_enumeration (t);
+
+  while (!NILP (alist))
+    {
+      if (value & XINT (XCDR (XCAR (alist))))
+       {
+         rval = Fcons (XCAR (XCAR (alist)), rval);
+         value &= ~(XINT (XCDR (XCAR (alist))));
+       }
+      alist = XCDR (alist);
+    }
+  return (rval);
+}
+
+static Lisp_Object
+enum_to_symbol (guint value, GtkType t)
+{
+  Lisp_Object alist = get_enumeration (t);
+  Lisp_Object cell = Qnil;
+
+  if (NILP (alist))
+    {
+      signal_simple_error ("Unkown enumeration", build_string (gtk_type_name (t)));
+    }
+
+  cell = Frassq (make_int (value), alist);
+
+  return (NILP (cell) ? Qnil : XCAR (cell));
+}

diff --git a/src/ui-gtk.h b/src/ui-gtk.h
new file mode 100644 (file)
index 0000000..8fb48d1
--- /dev/null
+++ b/src/ui-gtk.h
@@ -0,0 +1,71 @@
+/* ui-gtk.h
+**
+** Description: 
+**
+** Created by: William M. Perry
+** Copyright (c) 2000 Aventail Corporation
+**
+*/
+
+#ifndef __UI_GTK_H__
+#define __UI_GTK_H__
+
+/* Encapsulate a foreign function call */
+#include <gtk/gtk.h>
+#include "sysdll.h"
+#include "lrecord.h"
+
+typedef void (*ffi_actual_function) (void);
+typedef void (*ffi_marshalling_function) (ffi_actual_function, GtkArg *);
+
+#define MAX_GTK_ARGS 100
+
+typedef struct {
+  struct lcrecord_header header;
+  GtkType return_type;
+  GtkType args[MAX_GTK_ARGS];
+  gint n_args;
+  Lisp_Object function_name;
+  dll_func function_ptr;
+  ffi_marshalling_function marshal;
+} emacs_ffi_data;
+
+DECLARE_LRECORD (emacs_ffi, emacs_ffi_data);
+
+#define XFFI(x) XRECORD (x, emacs_ffi, emacs_ffi_data)
+#define XSETFFI(x,p) XSETRECORD (x, p, emacs_ffi)
+#define FFIP(x) RECORDP (x, emacs_ffi)
+#define CHECK_FFI(x) CHECK_RECORD (x, emacs_ffi)
+
+/* Encapsulate a GtkObject in Lisp */
+typedef struct {
+  struct lcrecord_header header;
+  gboolean alive_p;
+  GtkObject *object;
+  Lisp_Object plist;
+} emacs_gtk_object_data;
+
+DECLARE_LRECORD (emacs_gtk_object, emacs_gtk_object_data);
+
+#define XGTK_OBJECT(x) XRECORD (x, emacs_gtk_object, emacs_gtk_object_data)
+#define XSETGTK_OBJECT(x,p) XSETRECORD (x, p, emacs_gtk_object)
+#define GTK_OBJECTP(x) RECORDP (x, emacs_gtk_object)
+#define CHECK_GTK_OBJECT(x) CHECK_RECORD (x, emacs_gtk_object)
+
+extern Lisp_Object build_gtk_object (GtkObject *obj);
+
+/* Encapsulate a GTK_TYPE_BOXED in lisp */
+typedef struct {
+  struct lcrecord_header header;
+  GtkType object_type;
+  void *object;
+} emacs_gtk_boxed_data;
+
+DECLARE_LRECORD (emacs_gtk_boxed, emacs_gtk_boxed_data);
+
+#define XGTK_BOXED(x) XRECORD (x, emacs_gtk_boxed, emacs_gtk_boxed_data)
+#define XSETGTK_BOXED(x,p) XSETRECORD (x, p, emacs_gtk_boxed)
+#define GTK_BOXEDP(x) RECORDP (x, emacs_gtk_boxed)
+#define CHECK_GTK_BOXED(x) CHECK_RECORD (x, emacs_gtk_boxed)
+
+#endif /* __UI_GTK_H__ */

diff --git a/tests/gtk/UNIMPLEMENTED b/tests/gtk/UNIMPLEMENTED
new file mode 100644 (file)
index 0000000..5b8dd29
--- /dev/null
+++ b/tests/gtk/UNIMPLEMENTED
@@ -0,0 +1,12 @@
+This is a list of all the tests from GTK+ 1.2.8 that are not implemented.
+
+item factory     -- Widget is not supported (useless with XEmacs menubar construction code)
+rc file                  -- Function not imported
+test idle        -- XEmacs already has this functionality, no need to export GTK equivalent
+cursors                  -- No converter from glyph to GdkCursor defined
+saved position
+shapes
+
+layout
+modal window
+tree

diff --git a/tests/gtk/event-stream-tests.el b/tests/gtk/event-stream-tests.el
new file mode 100644 (file)
index 0000000..3cdaf8e
--- /dev/null
+++ b/tests/gtk/event-stream-tests.el
@@ -0,0 +1,74 @@
+;also do this: make two frames, one viewing "*scratch*", the other "foo".
+;in *scratch*, type (sit-for 20)^J
+;wait a couple of seconds, move cursor to foo, type "a"
+;a should be inserted in foo.  Cursor highlighting should not change in
+;the meantime.
+
+;do it with sleep-for.  move cursor into foo, then back into *scratch*
+;before typing.
+;repeat also with (accept-process-output nil 20)
+
+;make sure ^G aborts sit-for, sleep-for and accept-process-output:
+
+ (defun tst ()
+  (list (condition-case c
+           (sleep-for 20)
+         (quit c))
+       (read-char)))
+
+ (tst)^Ja^G    ==>  ((quit) 97) with no signal
+ (tst)^J^Ga    ==>  ((quit) 97) with no signal
+ (tst)^Jabc^G  ==>  ((quit) 97) with no signal, and "bc" inserted in buffer
+
+; with sit-for only do the 2nd test.
+; Do all 3 tests with (accept-proccess-output nil 20)
+
+/*
+Additional test cases for accept-process-output, sleep-for, sit-for.
+Be sure you do all of the above checking for C-g and focus, too!
+
+; Make sure that timer handlers are run during, not after sit-for:
+(defun timer-check ()
+  (add-timeout 2 '(lambda (ignore) (message "timer ran")) nil)
+  (sit-for 5)
+  (message "after sit-for"))
+
+; The first message should appear after 2 seconds, and the final message
+; 3 seconds after that.
+; repeat above test with (sleep-for 5) and (accept-process-output nil 5)
+
+; Make sure that process filters are run during, not after sit-for.
+(defun fubar ()
+  (message "sit-for = %s" (sit-for 30)))
+(add-hook 'post-command-hook 'fubar)
+
+; Now type M-x shell RET
+; wait for the shell prompt then send: ls RET
+; the output of ls should fill immediately, and not wait 30 seconds.
+
+; repeat above test with (sleep-for 30) and (accept-process-output nil 30)
+
+
+
+; Make sure that recursive invocations return immediately:
+(defmacro test-diff-time (start end)
+  `(+ (* (- (car ,end) (car ,start)) 65536.0)
+      (- (cadr ,end) (cadr ,start))
+      (/ (- (caddr ,end) (caddr ,start)) 1000000.0)))
+
+(defun testee (ignore)
+  (sit-for 10))
+
+(defun test-them ()
+  (let ((start (current-time))
+        end)
+    (add-timeout 2 'testee nil)
+    (sit-for 5)
+    (add-timeout 2 'testee nil)
+    (sleep-for 5)
+    (add-timeout 2 'testee nil)
+    (accept-process-output nil 5)
+    (setq end (current-time))
+    (test-diff-time start end)))
+
+(test-them) should sit for 15 seconds.

diff --git a/tests/gtk/gnome-test.el b/tests/gtk/gnome-test.el
new file mode 100644 (file)
index 0000000..8b0faf9
--- /dev/null
+++ b/tests/gtk/gnome-test.el
@@ -0,0 +1,247 @@
+(require 'gnome)
+
+(gtk-define-test
+ "GNOME Stock Pixmaps" gnome gnome-pixmaps nil
+ (let ((hbox nil)
+       (vbox nil)
+       (widget nil)
+       (label nil)
+       (i 0))
+   (mapc (lambda (b)
+          (if (= (% i 5) 0)
+              (progn
+                (setq hbox (gtk-hbutton-box-new))
+                (gtk-box-set-spacing hbox 5)
+                (gtk-container-add window hbox)))
+
+          (setq widget (gnome-stock-pixmap-widget-new window (car b))
+                vbox (gtk-vbox-new t 0)
+                label (gtk-label-new (cdr b)))
+          (gtk-container-add hbox vbox)
+          (gtk-container-add vbox widget)
+          (gtk-container-add vbox label)
+          (gtk-widget-show-all vbox)
+          (setq i (1+ i)))
+        gnome-stock-pixmaps))) 
+
+(gtk-define-test
+ "GNOME Stock Buttons" gnome gnome-buttons nil
+ (let ((hbbox nil)
+       (button nil)
+       (i 0))
+   (mapc (lambda (b)
+          (setq button (gnome-stock-button (car b)))
+          (gtk-signal-connect button 'clicked (lambda (obj data)
+                                                (message "Stock GNOME Button: %s" data))
+                              (cdr b))
+          (if (= (% i 3) 0)
+              (progn
+                (setq hbbox (gtk-hbutton-box-new))
+                (gtk-button-box-set-spacing hbbox 5)
+                (gtk-container-add window hbbox)))
+              
+          (gtk-container-add hbbox button)
+          (gtk-widget-show button)
+          (setq i (1+ i)))
+        gnome-stock-buttons)))
+        
+(gtk-define-test
+ "GNOME About" gnome gnome-about t
+ (setq window (gnome-about-new "XEmacs/GTK Test Application"
+                              "1.0a"
+                              "Copyright (C) 2000 Free Software Foundation"
+                              '("William M. Perry <wmperry@gnu.org>"
+                                "Ichabod Crane")
+                              "This is a comment string... what wonderful commentary you have my dear!"
+                              "")))
+
+(gtk-define-test
+ "GNOME File Entry" gnome gnome-file-entry nil
+ (let ((button (gnome-file-entry-new nil "Test browse dialog...")))
+   (gtk-container-add window button)))
+ 
+(gtk-define-test
+ "GNOME Color Picker" gnome gnome-color-picker nil
+ (let ((picker (gnome-color-picker-new))
+       (hbox (gtk-hbox-new nil 0))
+       (label (gtk-label-new "Please choose a color: ")))
+
+   (gtk-box-pack-start hbox label nil nil 2)
+   (gtk-box-pack-start hbox picker t t 2)
+   (gtk-container-add window hbox)
+   (gtk-widget-show-all hbox)))
+
+(gtk-define-test
+ "GNOME Desktop Entry Editor" gnome gnome-dentry-edit nil
+ (let* ((notebook (gtk-notebook-new)))
+   (gnome-dentry-edit-new-notebook notebook)
+   (gtk-container-add window notebook)))
+
+(gtk-define-test
+ "GNOME Date Edit" gnome gnome-date-entry nil
+ (let ((date (gnome-date-edit-new 0 t t))
+       button)
+   (gtk-box-pack-start window date t t 0)
+
+   (setq button (gtk-check-button-new-with-label "Show time"))
+   (gtk-signal-connect button 'clicked
+                      (lambda (button date)
+                        (let ((flags (gnome-date-edit-get-flags date)))
+                          (if (gtk-toggle-button-get-active button)
+                              (push 'show-time flags)
+                            (setq flags (delq 'show-time flags)))
+                          (gnome-date-edit-set-flags date flags))) date)
+   (gtk-toggle-button-set-active button t)
+   (gtk-box-pack-start window button nil nil 0)
+
+   (setq button (gtk-check-button-new-with-label "24 Hour format"))
+   (gtk-signal-connect button 'clicked
+                      (lambda (button date)
+                        (let ((flags (gnome-date-edit-get-flags date)))
+                          (if (gtk-toggle-button-get-active button)
+                              (push '24-hr flags)
+                            (setq flags (delq '24-hr flags)))
+                          (gnome-date-edit-set-flags date flags))) date)
+   (gtk-toggle-button-set-active button t)
+   (gtk-box-pack-start window button nil nil 0)
+
+   (setq button (gtk-check-button-new-with-label "Week starts on monday"))
+   (gtk-signal-connect button 'clicked
+                      (lambda (button date)
+                        (let ((flags (gnome-date-edit-get-flags date)))
+                          (if (gtk-toggle-button-get-active button)
+                              (push 'week-starts-on-monday flags)
+                            (setq flags (delq 'week-starts-on-monday flags)))
+                          (gnome-date-edit-set-flags date flags))) date)
+   (gtk-toggle-button-set-active button t)
+   (gtk-box-pack-start window button nil nil 0)))
+   
+(gtk-define-test
+ "GNOME Font Picker" gnome gnome-font-picker nil
+ (let ((hbox (gtk-hbox-new nil 5))
+       (fp (gnome-font-picker-new))
+       (label (gtk-label-new "Choose a font: "))
+       (button nil))
+   (gtk-box-pack-start hbox label t t 0)
+   (gtk-box-pack-start hbox fp nil nil 2)
+   (gnome-font-picker-set-title fp "Select a font...")
+   (gnome-font-picker-set-mode fp 'font-info)
+   (gtk-box-pack-start window hbox t t 0)
+
+   (setq button (gtk-check-button-new-with-label "Use font in label"))
+   (gtk-signal-connect button 'clicked
+                      (lambda (button fp)
+                        (gnome-font-picker-fi-set-use-font-in-label
+                         fp (gtk-toggle-button-get-active button) 14))
+                      fp)
+   (gtk-box-pack-start window button nil nil 0)
+
+   (setq button (gtk-check-button-new-with-label "Show size"))
+   (gtk-signal-connect button 'clicked
+                      (lambda (button fp)
+                        (gnome-font-picker-fi-set-show-size
+                         fp (gtk-toggle-button-get-active button)))
+                      fp)
+   (gtk-box-pack-start window button nil nil 0)))
+
+(gtk-define-test
+ "GNOME Application" gnome gnome-app t
+ (setq window (gnome-app-new "XEmacs" "XEmacs/GNOME"))
+ (let ((menubar (gtk-menu-bar-new))
+       (contents nil)
+       ;(toolbar-instance (specifier-instance top-toolbar))
+       (toolbar nil)
+       (item nil)
+       (flushright nil))
+   (mapc (lambda (node)
+          (if (not node)
+              (setq flushright t)
+            (setq item (gtk-build-xemacs-menu node))
+            (gtk-widget-show item)
+            (if flushright (gtk-menu-item-right-justify item))
+            (gtk-menu-append menubar item)))
+        current-menubar)
+
+   (setq toolbar (gtk-toolbar-new 'horizontal 'both))
+   (mapc (lambda (x)
+          (let ((button (gtk-button-new))
+                (pixmap (gnome-stock-pixmap-widget-new toolbar x)))
+            (gtk-container-add button pixmap)
+            (gtk-toolbar-append-widget toolbar button (symbol-name x) nil)))
+        '(open save print cut copy paste undo spellcheck srchrpl mail help))
+
+   (setq contents (gtk-hbox-new nil 5))
+   (let ((hbox contents)
+        (vbox (gtk-vbox-new nil 5))
+        (frame nil)
+        (label nil))
+     (gtk-box-pack-start hbox vbox nil nil 0)
+
+     (setq frame (gtk-frame-new "Normal Label")
+          label (gtk-label-new "This is a Normal label"))
+     (gtk-container-add frame label)
+     (gtk-box-pack-start vbox frame nil nil 0)
+
+     (setq frame (gtk-frame-new "Multi-line Label")
+          label (gtk-label-new "This is a multi-line label.\nSecond line\nThird line"))
+     (gtk-container-add frame label)
+     (gtk-box-pack-start vbox frame nil nil 0)
+
+     (setq frame (gtk-frame-new "Left Justified Label")
+          label (gtk-label-new "This is a Left-Justified\nMulti-line label.\nThird      line"))
+     (gtk-label-set-justify label 'left)
+     (gtk-container-add frame label)
+     (gtk-box-pack-start vbox frame nil nil 0)
+
+     (setq frame (gtk-frame-new "Right Justified Label")
+          label (gtk-label-new "This is a Right-Justified\nMulti-line label.\nFourth line, (j/k)"))
+     (gtk-label-set-justify label 'right)
+     (gtk-container-add frame label)
+     (gtk-box-pack-start vbox frame nil nil 0)
+
+     ;; Start a second row so that we don't make a ridiculously tall window
+     (setq vbox (gtk-vbox-new nil 5))
+     (gtk-box-pack-start hbox vbox nil nil 0)
+
+     (setq frame (gtk-frame-new "Line wrapped label")
+          label (gtk-label-new
+                 (concat "This is an example of a line-wrapped label.  It should not be taking "
+                         "up the entire             " ;;; big space to test spacing
+                         "width allocated to it, but automatically wraps the words to fit.  "
+                         "The time has come, for all good men, to come to the aid of their party.  "
+                         "The sixth sheik's six sheep's sick.\n"
+                         "     It supports multiple paragraphs correctly, and  correctly   adds "
+                         "many          extra  spaces. ")))
+     (gtk-label-set-line-wrap label t)
+     (gtk-container-add frame label)
+     (gtk-box-pack-start vbox frame nil nil 0)
+
+     (setq frame (gtk-frame-new "Filled, wrapped label")
+          label (gtk-label-new
+                 (concat
+                  "This is an example of a line-wrapped, filled label.  It should be taking "
+                  "up the entire              width allocated to it.  Here is a seneance to prove "
+                  "my point.  Here is another sentence. "
+                  "Here comes the sun, do de do de do.\n"
+                  "    This is a new paragraph.\n"
+                  "    This is another newer, longer, better paragraph.  It is coming to an end, "
+                  "unfortunately.")))
+     (gtk-label-set-justify label 'fill)
+     (gtk-label-set-line-wrap label t)
+     (gtk-container-add frame label)
+     (gtk-box-pack-start vbox frame nil nil 0)
+
+     (setq frame (gtk-frame-new "Underlined label")
+          label (gtk-label-new (concat "This label is underlined!\n"
+                                       "This one is underlined in ÆüËܸì¤ÎÆþÍÑquite a funky fashion")))
+     (gtk-label-set-justify label 'left)
+     (gtk-label-set-pattern label "_________________________ _ _________ _ _____ _ __ __  ___ ____ _____")
+     (gtk-container-add frame label)
+     (gtk-box-pack-start vbox frame nil nil 0))
+ 
+   (gtk-widget-show-all toolbar)
+   (gtk-widget-show-all menubar)
+   (gtk-widget-show-all contents)
+   (gnome-app-set-menus window menubar)
+   (gnome-app-set-toolbar window toolbar)
+   (gnome-app-set-contents window contents)))

diff --git a/tests/gtk/gtk-embedded-test.el b/tests/gtk/gtk-embedded-test.el
new file mode 100644 (file)
index 0000000..3752dd6
--- /dev/null
+++ b/tests/gtk/gtk-embedded-test.el
@@ -0,0 +1,32 @@
+(gtk-define-test
+ "Embedded XEmacs frame" xemacs-frame t
+ (setq window (gtk-window-new 'toplevel))
+ (let ((table (gtk-table-new 5 3 nil))
+       (label nil)
+       (entry nil)
+       (frame (gtk-frame-new "Type mail message here...")))
+   (gtk-container-add window table)
+
+   (setq label (gtk-label-new "To: ")
+        entry (gtk-entry-new))
+   (gtk-table-attach table label 0 1 0 1 nil nil 0 0)
+   (gtk-table-attach table entry 1 2 0 1 '(fill) '(fill) 0 0)
+
+   (setq label (gtk-label-new "CC: ")
+        entry (gtk-entry-new))
+   (gtk-table-attach table label 0 1 1 2 nil nil 0 0)
+   (gtk-table-attach table entry 1 2 1 2 '(fill) '(fill) 0 0)
+
+   (setq label (gtk-label-new "Subject: ")
+        entry (gtk-entry-new))
+   (gtk-table-attach table label 0 1 2 3 nil nil 0 0)
+   (gtk-table-attach table entry 1 2 2 3 '(fill) '(fill) 0 0)
+
+   (gtk-table-attach table frame 0 2 3 4 '(expand fill) '(expand fill) 5 5)
+   
+   (gtk-widget-show-all window)
+   (gdk-flush)
+   (make-frame (list 'window-id frame
+                    'unsplittable t
+                    'menubar-visible-p nil
+                    'default-toolbar-visible-p nil))))

diff --git a/tests/gtk/gtk-extra-test.el b/tests/gtk/gtk-extra-test.el
new file mode 100644 (file)
index 0000000..5e7b00e
--- /dev/null
+++ b/tests/gtk/gtk-extra-test.el
@@ -0,0 +1,26 @@
+(require 'gtk-extra)
+
+(gtk-define-test
+ "Color Combo" extra color-combo nil
+ (let ((combo (gtk-color-combo-new)))
+   (gtk-box-pack-start window combo nil nil 0)))
+
+(gtk-define-test
+ "Directory Tree" extra dirtree nil
+ (let ((dir (gtk-dir-tree-new)))
+   (gtk-box-pack-start window dir nil nil 0)
+   (gtk-dir-tree-open-dir dir "/")))
+
+(gtk-define-test
+ "File List" extra filelist nil
+ (let ((scrolled (gtk-scrolled-window-new nil nil))
+       (list (gtk-file-list-new 32 2 "/")))
+   (gtk-scrolled-window-add-with-viewport scrolled list)
+   (put scrolled 'height 200)
+   (gtk-box-pack-start window scrolled t t 0)))
+
+(gtk-define-test
+ "Font Combo" extra fontcombo nil
+ (let ((fc (gtk-font-combo-new)))
+   (gtk-box-pack-start window fc t t 0)))
+   

diff --git a/tests/gtk/gtk-test.el b/tests/gtk/gtk-test.el
new file mode 100644 (file)
index 0000000..8f2b021
--- /dev/null
+++ b/tests/gtk/gtk-test.el
@@ -0,0 +1,2044 @@
+;;; gtk-test.el --- Test harness for GTK widgets
+
+;; Copyright (C) 2000 Free Software Foundation
+
+;; Maintainer: William Perry <wmperry@gnu.org>
+;; Keywords: tests
+
+;; 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, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+(require 'font)
+
+(setq GTK_TOPLEVEL             (lsh 1 4)
+      GTK_NO_WINDOW            (lsh 1 5)
+      GTK_REALIZED             (lsh 1 6)
+      GTK_MAPPED               (lsh 1 7)
+      GTK_VISIBLE              (lsh 1 8)
+      GTK_SENSITIVE            (lsh 1 9)
+      GTK_PARENT_SENSITIVE     (lsh 1 10)
+      GTK_CAN_FOCUS            (lsh 1 11)
+      GTK_HAS_FOCUS            (lsh 1 12)
+      GTK_CAN_DEFAULT          (lsh 1 13)
+      GTK_HAS_DEFAULT          (lsh 1 14)
+      GTK_HAS_GRAB             (lsh 1 15)
+      GTK_RC_STYLE             (lsh 1 16)
+      GTK_COMPOSITE_CHILD      (lsh 1 17)
+      GTK_NO_REPARENT          (lsh 1 18)
+      GTK_APP_PAINTABLE                (lsh 1 19)
+      GTK_RECEIVES_DEFAULT     (lsh 1 20))
+
+(defun gtk-widget-visible (widget)
+  (= (logand (gtk-object-flags widget) GTK_VISIBLE) GTK_VISIBLE))
+
+(defvar gtk-defined-tests nil
+  "A list describing the defined tests.
+Each element is of the form (DESCRIPTION TYPE FUNCTION)")
+
+(defvar gtk-test-directory nil)
+(defun gtk-test-directory ()
+  (if (not gtk-test-directory)
+      (mapc (lambda (c)
+             (if (and (not gtk-test-directory)
+                      (string= (file-name-nondirectory (car c)) "gtk-test.el"))
+                 (setq gtk-test-directory (file-name-directory (car c)))))
+           load-history))
+  gtk-test-directory)
+
+(defvar gtk-test-categories '((container . "Containers")
+                             (basic     . "Basic Widgets")
+                             (composite . "Composite Widgets")
+                             (gimp      . "Gimp Widgets")
+                             (misc      . "Miscellaneous")
+                             (extra     . "GTK+ Extra")
+                             (gdk       . "GDK Primitives")
+                             (gnome     . "GNOME tests"))
+  "An assoc list mapping test categories to friendly names.")
+
+(defvar gtk-test-open-glyph
+  (make-glyph [xpm :data "/* XPM */\nstatic char * book_open_xpm[] = {\n\"16 16 4 1\",\n\"       c None s None\",\n\".      c black\",\n\"X      c #808080\",\n\"o      c white\",\n\"                \",\n\"  ..            \",\n\" .Xo.    ...    \",\n\" .Xoo. ..oo.    \",\n\" .Xooo.Xooo...  \",\n\" .Xooo.oooo.X.  \",\n\" .Xooo.Xooo.X.  \",\n\" .Xooo.oooo.X.  \",\n\" .Xooo.Xooo.X.  \",\n\" .Xooo.oooo.X.  \",\n\"  .Xoo.Xoo..X.  \",\n\"   .Xo.o..ooX.  \",\n\"    .X..XXXXX.  \",\n\"    ..X.......  \",\n\"     ..         \",\n\"                \"};"]))
+
+(defvar gtk-test-closed-glyph
+  (make-glyph [xpm :data "/* XPM */\nstatic char * book_closed_xpm[] = {\n\"16 16 6 1\",\n\"       c None s None\",\n\".      c black\",\n\"X      c red\",\n\"o      c yellow\",\n\"O      c #808080\",\n\"#      c white\",\n\"                \",\n\"       ..       \",\n\"     ..XX.      \",\n\"   ..XXXXX.     \",\n\" ..XXXXXXXX.    \",\n\".ooXXXXXXXXX.   \",\n\"..ooXXXXXXXXX.  \",\n\".X.ooXXXXXXXXX. \",\n\".XX.ooXXXXXX..  \",\n\" .XX.ooXXX..#O  \",\n\"  .XX.oo..##OO. \",\n\"   .XX..##OO..  \",\n\"    .X.#OO..    \",\n\"     ..O..      \",\n\"      ..        \",\n\"                \"};\n"]))
+
+(defvar gtk-test-mini-page-glyph
+  (make-glyph [xpm :data "/* XPM */\nstatic char * mini_page_xpm[] = {\n\"16 16 4 1\",\n\"       c None s None\",\n\".      c black\",\n\"X      c white\",\n\"o      c #808080\",\n\"                \",\n\"   .......      \",\n\"   .XXXXX..     \",\n\"   .XoooX.X.    \",\n\"   .XXXXX....   \",\n\"   .XooooXoo.o  \",\n\"   .XXXXXXXX.o  \",\n\"   .XooooooX.o  \",\n\"   .XXXXXXXX.o  \",\n\"   .XooooooX.o  \",\n\"   .XXXXXXXX.o  \",\n\"   .XooooooX.o  \",\n\"   .XXXXXXXX.o  \",\n\"   ..........o  \",\n\"    oooooooooo  \",\n\"                \"};\n"]))
+
+(defvar gtk-test-mini-gtk-glyph
+  (make-glyph [xpm :data "/* XPM */\nstatic char * gtk_mini_xpm[] = {\n\"15 20 17 1\",\n\"       c None\",\n\".      c #14121F\",\n\"+      c #278828\",\n\"@      c #9B3334\",\n\"#      c #284C72\",\n\"$      c #24692A\",\n\"%      c #69282E\",\n\"&      c #37C539\",\n\"*      c #1D2F4D\",\n\"=      c #6D7076\",\n\"-      c #7D8482\",\n\";      c #E24A49\",\n\">      c #515357\",\n\",      c #9B9C9B\",\n\"'      c #2FA232\",\n\")      c #3CE23D\",\n\"!      c #3B6CCB\",\n\"               \",\n\"      ***>     \",\n\"    >.*!!!*    \",\n\"   ***....#*=  \",\n\"  *!*.!!!**!!# \",\n\" .!!#*!#*!!!!# \",\n\" @%#!.##.*!!$& \",\n\" @;%*!*.#!#')) \",\n\" @;;@%!!*$&)'' \",\n\" @%.%@%$'&)$+' \",\n\" @;...@$'*'*)+ \",\n\" @;%..@$+*.')$ \",\n\" @;%%;;$+..$)# \",\n\" @;%%;@$$$'.$# \",\n\" %;@@;;$$+))&* \",\n\"  %;;;@+$&)&*  \",\n\"   %;;@'))+>   \",\n\"    %;@'&#     \",\n\"     >%$$      \",\n\"      >=       \"};"]))
+
+
+(defun build-option-menu (items history obj)
+  (let (omenu menu menu-item group i)
+    (setq omenu (gtk-option-menu-new)
+         menu (gtk-menu-new)
+         i 0)
+
+    (while items
+      (setq menu-item (gtk-radio-menu-item-new-with-label group (car (car items))))
+      (gtk-signal-connect menu-item 'activate (cdr (car items)) obj)
+      (setq group (gtk-radio-menu-item-group menu-item))
+      (gtk-menu-append menu menu-item)
+      (if (= i history)
+         (gtk-check-menu-item-set-active menu-item t))
+      (gtk-widget-show menu-item)
+      (setq items (cdr items))
+      (incf i))
+
+    (gtk-option-menu-set-menu omenu menu)
+    (gtk-option-menu-set-history omenu history)
+    omenu))
+
+(defun gtk-test-notice-destroy (object symbol)
+  ;; Set variable to NIL to aid in object destruction.
+  (set symbol nil))
+
+(defun gtk-test-make-sample-buttons (box maker)
+  ;; Create buttons and pack them in a premade BOX.
+  (mapcar (lambda (name)
+           (let ((button (funcall maker name)))
+             (gtk-box-pack-start box button t t 0)
+             (gtk-widget-show button)
+             button)) '("button1" "button2" "button3")))
+
+(make-face 'gtk-test-face-large "A face with a large font, for use in GTK test cases")
+(font-set-face-font 'gtk-test-face-large
+              (make-font :family '("LucidaBright" "Utopia" "Helvetica" "fixed")
+                         :weight :normal
+                         :size "36pt"))
+
+(defvar gtk-test-shell nil
+  "Where non-dialog tests should realize their widgets.")
+
+(defmacro gtk-define-test (title type name-stub dialog-p &rest body)
+  "Define a GTK demo/test.
+TITLE is the friendly name of the test to show to the user.
+TYPE is used to sort the items.
+NAME-STUB is used to create the function definition.
+DIALOG-P must be non-nil for demos that create their own top-level window.
+BODY are the forms that actually create the demo.
+
+They must pack their widgets into the dynamically bound WINDOW variable,
+which is a GtkVBox.
+"
+  `(progn
+     (if (not (assoc ,title gtk-defined-tests))
+        (push (list ,title (quote ,type)
+                    (quote ,(intern (format "gtk-test-%s" name-stub)))) gtk-defined-tests))
+     (defun ,(intern (format "gtk-test-%s" name-stub)) ()
+       (let ((main-widget (if (not gtk-test-shell)
+                             (gtk-window-new 'toplevel)
+                           (gtk-frame-new ,title)))
+            (window nil))
+        (if gtk-test-shell
+            (progn
+              (mapc 'gtk-widget-destroy (gtk-container-children gtk-test-shell))
+              (gtk-box-pack-start gtk-test-shell main-widget nil nil 0))
+          (gtk-window-set-title main-widget ,title))
+        (if ,dialog-p
+            (let ((button (gtk-button-new-with-label ,title))
+                  (blank (gtk-event-box-new)))
+              (setq window (gtk-hbox-new nil 0))
+              (gtk-signal-connect button 'clicked
+                                  (lambda (&rest ignored)
+                                    (let ((window nil))
+                                      ,@body
+                                      (gtk-widget-show-all window))))
+              (gtk-box-pack-start window
+                                  (gtk-label-new
+                                   (concat "This demo creates an external dialog.\n"
+                                           "Activate the button to see the demo."))
+                                  nil nil 0)
+              (gtk-box-pack-start window button nil nil 0)
+              (gtk-box-pack-start window blank t t 0)
+              (gtk-widget-show-all main-widget))
+          (setq window (gtk-vbox-new nil 0))
+          ,@body)
+        (gtk-container-add main-widget window)
+        (gtk-widget-show-all (or main-widget window))))))
+
+\f
+;;;; Pixmaps
+(gtk-define-test
+  "Pixmaps" misc pixmap nil
+  (let* ((button (gtk-button-new))
+        (pixmap (gtk-pixmap-new xemacs-logo nil))
+        (label (gtk-label-new "Pixmap test"))
+        (hbox (gtk-hbox-new nil 0)))
+    (gtk-box-pack-start window button nil nil 0)
+    (gtk-widget-show button)
+    (gtk-container-set-border-width hbox 2)
+    (gtk-container-add hbox pixmap)
+    (gtk-container-add hbox label)
+    (gtk-container-add button hbox)
+    (gtk-widget-show pixmap)
+    (gtk-widget-show label)
+    (gtk-widget-show hbox)))
+
+\f
+;;;; Scrolled windows
+(gtk-define-test
+ "Scrolled windows" container create-scrolled-windows nil
+ (let* ((scrolled-win (gtk-scrolled-window-new nil nil))
+       (viewport (gtk-viewport-new
+                  (gtk-scrolled-window-get-hadjustment scrolled-win)
+                  (gtk-scrolled-window-get-vadjustment scrolled-win)))
+       (table (gtk-table-new 20 20 nil))
+       (button nil))
+   (gtk-container-set-border-width window 0)
+   (gtk-container-set-border-width scrolled-win 10)
+   (gtk-scrolled-window-set-policy scrolled-win 'automatic 'automatic)
+   (gtk-box-pack-start window scrolled-win t t 0)
+   (gtk-table-set-row-spacings table 10)
+   (gtk-table-set-col-spacings table 10)
+   (gtk-scrolled-window-add-with-viewport scrolled-win table)
+   (gtk-container-set-focus-hadjustment 
+    table (gtk-scrolled-window-get-hadjustment scrolled-win))
+   (gtk-container-set-focus-vadjustment 
+    table (gtk-scrolled-window-get-vadjustment scrolled-win))
+   (loop for i from 0 to 19 do
+     (loop for j from 0 to 19 do
+       (setq button (gtk-button-new-with-label (format "button (%d, %d)\n" i j)))
+       (gtk-table-attach-defaults table button i (1+ i) j (1+ j))))
+   (gtk-widget-show-all scrolled-win)))
+
+\f
+;;;; Lists
+(gtk-define-test
+ "List" basic create-list nil
+ (let ((list-items '("hello" 
+                    "world"
+                    "blah"
+                    "foo"
+                    "bar"
+                    "argh"
+                    "wmperry"
+                    "is a"
+                    "wussy"
+                    "programmer"))
+       (scrolled-win (gtk-scrolled-window-new nil nil))
+       (lyst (gtk-list-new))
+       (add (gtk-button-new-with-label "add"))
+       (remove (gtk-button-new-with-label "remove")))
+
+   (gtk-scrolled-window-set-policy scrolled-win 'automatic 'automatic)
+   (gtk-box-pack-start window scrolled-win t t 0)
+   (gtk-widget-show scrolled-win)
+
+   (gtk-list-set-selection-mode lyst 'multiple)
+   (gtk-list-set-selection-mode lyst 'browse)
+   (gtk-scrolled-window-add-with-viewport scrolled-win lyst)
+   (gtk-widget-show lyst)
+
+   (mapc (lambda (i)
+          (let ((list-item (gtk-list-item-new-with-label i)))
+            (gtk-container-add lyst list-item)
+            (gtk-widget-show list-item)))
+        list-items)
+
+   (gtk-signal-connect add 'clicked
+                      (lambda (obj data) (message "Should add to the list")))
+   (gtk-box-pack-start window add nil t 0)
+   (gtk-widget-show add)
+
+   (gtk-signal-connect remove 'clicked
+                      (lambda (obj list)
+                        (if (gtk-list-selection list)
+                            (gtk-list-remove-items list (gtk-list-selection list)))) lyst)
+   (gtk-box-pack-start window remove nil t 0)
+   (gtk-widget-show remove)
+
+   (gtk-signal-connect lyst 'select_child 
+                      (lambda (lyst child ignored)
+                        (message "selected %S %d" child (gtk-list-child-position lyst child))))
+
+   (gtk-widget-set-usize scrolled-win 200 75)
+
+   (gtk-signal-connect lyst 'unselect_child (lambda (lyst child ignored)
+                                             (message "unselected %S" child)))))
+
+\f
+;;;; Tooltips
+(defvar gtk-test-tooltips nil)
+
+(gtk-define-test
+ "Tooltips" composite create-tooltips nil
+  (if (not gtk-test-tooltips)
+      (setq gtk-test-tooltips (gtk-tooltips-new)))
+  (let ((buttons (gtk-test-make-sample-buttons window 'gtk-toggle-button-new-with-label))
+       (tips '("This is button 1"
+               "This is button 2"
+               "This is button 3. This is also a really long tooltip which probably won't fit on a single line and will therefore need to be wrapped. Hopefully the wrapping will work correctly.")))
+    (while buttons
+      (gtk-tooltips-set-tip gtk-test-tooltips (pop buttons) (pop tips) ""))))
+
+\f
+;;;; Panes
+(defun toggle-resize (widget child)
+  (let* ((paned (gtk-widget-parent child))
+        (is-child1 (eq child (gtk-paned-child1 paned)))
+        resize shrink)
+    (setq resize (if is-child1
+                    (gtk-paned-child1-resize paned)
+                  (gtk-paned-child2-resize paned))
+         shrink (if is-child1
+                    (gtk-paned-child1-shrink paned)
+                  (gtk-paned-child2-shrink paned)))
+
+    (gtk-widget-ref child)
+    (gtk-container-remove paned child)
+    (if is-child1
+       (gtk-paned-pack1 paned child (not resize) shrink)
+      (gtk-paned-pack2 paned child (not resize) shrink))
+    (gtk-widget-unref child)))
+
+(defun toggle-shrink (widget child)
+  (let* ((paned (gtk-widget-parent child))
+        (is-child1 (eq child (gtk-paned-child1 paned)))
+        resize shrink)
+    (setq resize (if is-child1
+                    (gtk-paned-child1-resize paned)
+                  (gtk-paned-child2-resize paned))
+         shrink (if is-child1
+                    (gtk-paned-child1-shrink paned)
+                  (gtk-paned-child2-shrink paned)))
+
+    (gtk-widget-ref child)
+    (gtk-container-remove paned child)
+    (if is-child1
+       (gtk-paned-pack1 paned child resize (not shrink))
+      (gtk-paned-pack2 paned child resize (not shrink)))
+    (gtk-widget-unref child)))
+
+(defun create-pane-options (widget frame-label label1 label2)
+  (let (frame table label check-button)
+    (setq frame (gtk-frame-new frame-label))
+    (gtk-container-set-border-width frame 4)
+
+    (setq table (gtk-table-new 3 2 4))
+    (gtk-container-add frame table)
+
+    (setq label (gtk-label-new label1))
+    (gtk-table-attach-defaults table label 0 1 0 1)
+
+    (setq check-button (gtk-check-button-new-with-label "Resize"))
+    (gtk-table-attach-defaults table check-button 0 1 1 2)
+    (gtk-signal-connect check-button 'toggled 'toggle-resize (gtk-paned-child1 widget))
+
+    (setq check-button (gtk-check-button-new-with-label "Shrink"))
+    (gtk-table-attach-defaults table check-button 0 1 2 3)
+    (gtk-toggle-button-set-active check-button t)
+    (gtk-signal-connect check-button 'toggled 'toggle-shrink (gtk-paned-child1 widget))
+
+    (setq label (gtk-label-new label2))
+    (gtk-table-attach-defaults table label 1 2 0 1)
+
+    (setq check-button (gtk-check-button-new-with-label "Resize"))
+    (gtk-table-attach-defaults table check-button 1 2 1 2)
+    (gtk-toggle-button-set-active check-button t)
+    (gtk-signal-connect check-button 'toggled 'toggle-resize (gtk-paned-child2 widget))
+
+    (setq check-button (gtk-check-button-new-with-label "Shrink"))
+    (gtk-table-attach-defaults table check-button 1 2 2 3)
+    (gtk-toggle-button-set-active check-button t)
+    (gtk-signal-connect check-button 'toggled 'toggle-shrink (gtk-paned-child2 widget))
+    frame))
+
+(gtk-define-test
+ "Panes" container panes nil
+ (let (frame hpaned vpaned button vbox)
+   (gtk-container-set-border-width window 0)
+
+   (setq vpaned (gtk-vpaned-new))
+   (gtk-box-pack-start window vpaned t t 0)
+   (gtk-container-set-border-width vpaned 5)
+
+   (setq hpaned (gtk-hpaned-new))
+   (gtk-paned-add1 vpaned hpaned)
+
+   (setq frame (gtk-frame-new nil))
+   (gtk-frame-set-shadow-type frame 'in)
+   (gtk-widget-set-usize frame 60 60)
+   (gtk-paned-add1 hpaned frame)
+
+   (setq button (gtk-button-new-with-label "Hi there"))
+   (gtk-container-add frame button)
+
+   (setq frame (gtk-frame-new nil))
+   (gtk-frame-set-shadow-type frame 'in)
+   (gtk-widget-set-usize frame 80 60)
+   (gtk-paned-add2 hpaned frame)
+
+   (setq frame (gtk-frame-new nil))
+   (gtk-frame-set-shadow-type frame 'in)
+   (gtk-widget-set-usize frame 60 80)
+   (gtk-paned-add2 vpaned frame)
+
+   ;; Now create toggle buttons to control sizing
+   (gtk-box-pack-start window (create-pane-options hpaned "Horizontal" "Left" "Right") nil nil 0)
+   (gtk-box-pack-start window (create-pane-options vpaned "Vertical" "Top" "Bottom") nil nil 0)
+   (gtk-widget-show-all window)))
+
+\f
+;;;; Entry
+(gtk-define-test
+ "Entry" basic entry nil
+ (let ((box1 nil)
+       (box2 nil)
+       (editable-check nil)
+       (sensitive-check nil)
+       (entry nil)
+       (cb nil)
+       (button nil)
+       (separator nil)
+       (cbitems '("item0"
+                 "item1 item1"
+                 "item2 item2 item2"
+                 "item3 item3 item3 item3"
+                 "item4 item4 item4 item4 item4"
+                 "item5 item5 item5 item5 item5 item5"
+                 "item6 item6 item6 item6 item6"
+                 "item7 item7 item7 item7"
+                 "item8 item8 item8"
+                 "item9 item9")))
+   (gtk-container-set-border-width window 0)
+
+   (setq box1 (gtk-vbox-new nil 0))
+   (gtk-container-add window box1)
+   (gtk-widget-show box1)
+
+   (setq box2 (gtk-vbox-new nil 10))
+   (gtk-container-set-border-width box2 10)
+   (gtk-box-pack-start box1 box2 t t 0)
+   (gtk-widget-show box2)
+
+   (setq entry (gtk-entry-new))
+   (gtk-entry-set-text entry "hello world")
+   (gtk-editable-select-region entry 0 5)
+   (gtk-box-pack-start box2 entry t t 0)
+   (gtk-widget-show entry)
+
+   (setq cb (gtk-combo-new))
+   (gtk-combo-set-popdown-strings cb cbitems)
+   (gtk-entry-set-text (gtk-combo-entry cb) "hellow world")
+   (gtk-editable-select-region (gtk-combo-entry cb) 0 -1)
+   (gtk-box-pack-start box2 cb t t 0)
+   (gtk-widget-show cb)
+
+   (setq editable-check (gtk-check-button-new-with-label "Editable"))
+   (gtk-box-pack-start box2 editable-check nil t 0)
+   (gtk-signal-connect editable-check 'toggled
+                      (lambda (obj data)
+                        (gtk-entry-set-editable
+                         data
+                         (gtk-toggle-button-get-active obj))) entry)
+   (gtk-toggle-button-set-active editable-check t)
+   (gtk-widget-show editable-check)
+
+   (setq editable-check (gtk-check-button-new-with-label "Visible"))
+   (gtk-box-pack-start box2 editable-check nil t 0)
+   (gtk-signal-connect editable-check 'toggled
+                      (lambda (obj data)
+                        (gtk-entry-set-visibility data
+                                                  (gtk-toggle-button-get-active obj))) entry)
+   (gtk-toggle-button-set-active editable-check t)
+   (gtk-widget-show editable-check)
+
+   (setq sensitive-check (gtk-check-button-new-with-label "Sensitive"))
+   (gtk-box-pack-start box2 sensitive-check nil t 0)
+   (gtk-signal-connect sensitive-check 'toggled
+                      (lambda (obj data)
+                        (gtk-widget-set-sensitive data
+                                                  (gtk-toggle-button-get-active obj))) entry)
+   (gtk-toggle-button-set-active sensitive-check t)
+   (gtk-widget-show sensitive-check)))
+
+\f
+;;;; Various built-in dialog types
+(gtk-define-test
+ "Font Dialog" composite font-selection t
+ (setq window (gtk-font-selection-dialog-new "font selection dialog"))
+ (gtk-font-selection-dialog-set-preview-text window "Set from Emacs Lisp!")
+ (gtk-signal-connect 
+  (gtk-font-selection-dialog-cancel-button window)
+  'clicked (lambda (button dlg)
+            (gtk-widget-destroy dlg))
+  window)
+ (gtk-signal-connect
+  (gtk-font-selection-dialog-ok-button window)
+  'clicked
+  (lambda (button dlg)
+    (message "Font selected: %s" (gtk-font-selection-dialog-get-font-name dlg)))
+  window))
+
+(gtk-define-test
+ "File Selection Dialog" composite file-selection t
+ (let (button)
+   (setq window (gtk-file-selection-new "file selection"))
+   (gtk-signal-connect
+    (gtk-file-selection-ok-button window)
+    'clicked (lambda (obj dlg) (message "You clicked ok: %s"
+                                       (gtk-file-selection-get-filename dlg)))
+    window)
+
+    (gtk-signal-connect 
+     (gtk-file-selection-cancel-button window)
+     'clicked (lambda (obj dlg) (gtk-widget-destroy dlg)) window)
+
+    (gtk-file-selection-hide-fileop-buttons window)
+
+    (setq button (gtk-button-new-with-label "Hide Fileops"))
+    (gtk-signal-connect 
+     button 'clicked
+     (lambda (obj dlg)
+       (gtk-file-selection-hide-fileop-buttons dlg)) window)
+
+    (gtk-box-pack-start (gtk-file-selection-action-area window)
+                       button nil nil 0)
+    (gtk-widget-show button)
+
+    (setq button (gtk-button-new-with-label "Show Fileops"))
+    (gtk-signal-connect 
+     button 'clicked
+     (lambda (obj dlg)
+       (gtk-file-selection-show-fileop-buttons dlg)) window)
+    (gtk-box-pack-start (gtk-file-selection-action-area window)
+                       button nil nil 0)
+    (gtk-widget-show button)))
+
+(gtk-define-test
+ "Color selection" composite color t
+ (setq window (gtk-color-selection-dialog-new "GTK color selection"))
+ (gtk-signal-connect (gtk-color-selection-dialog-cancel-button window)
+                    'clicked
+                    (lambda (button data)
+                      (gtk-widget-destroy data)) window)
+ (gtk-signal-connect (gtk-color-selection-dialog-ok-button window)
+                    'clicked
+                    (lambda (button data)
+                      (let ((rgba (gtk-color-selection-get-color
+                                   (gtk-color-selection-dialog-colorsel data)))
+                            r g b a)
+                        (setq r (pop rgba)
+                              g (pop rgba)
+                              b (pop rgba)
+                              a (pop rgba))
+                        (gtk-widget-destroy data)
+                        (message-box
+                         "You selected color: red (%04x) blue (%04x) green (%04x) alpha (%g)"
+                         (* 65535 r) (* 65535 g) (* 65535 b) a)))
+                    window))
+
+\f
+;;;; Dialog
+(defun gtk-container-specific-children (parent predicate &optional data)
+  (let ((children nil))
+    (mapc (lambda (w)
+           (if (funcall predicate w data)
+               (push w children)))
+         (gtk-container-children parent))
+    children))
+
+(gtk-define-test
+ "Dialog" basic dialog t
+ (let ((button nil)
+       (label nil))
+   (setq window (gtk-dialog-new))
+   (gtk-container-set-border-width window 0)
+   (gtk-widget-set-usize window 200 110)
+
+   (setq button (gtk-button-new-with-label "OK"))
+   (gtk-box-pack-start (gtk-dialog-action-area window) button t t 0)
+   (gtk-widget-show button)
+   (gtk-signal-connect button 'clicked
+                      (lambda (obj data)
+                        (gtk-widget-destroy data))
+                      window)
+
+   (setq button (gtk-button-new-with-label "Toggle"))
+   (gtk-signal-connect
+    button 'clicked
+    (lambda (button dlg)
+      (if (not (gtk-container-specific-children (gtk-dialog-vbox dlg)
+                                               (lambda (w ignored)
+                                                 (= (gtk-object-type w) (gtk-label-get-type)))))
+         (let ((label (gtk-label-new "Dialog Test")))
+           (gtk-box-pack-start (gtk-dialog-vbox dlg) label t t 0)
+           (gtk-widget-show label))
+       (mapc 'gtk-widget-destroy
+             (gtk-container-specific-children (gtk-dialog-vbox dlg)
+                                              (lambda (w ignored)
+                                                (= (gtk-object-type w) (gtk-label-get-type)))))))
+    window)
+   (gtk-box-pack-start (gtk-dialog-action-area window) button t t 0)
+   (gtk-widget-show button)))
+
+\f
+;;;; Range controls
+(gtk-define-test
+ "Range Controls" basic range-controls nil
+ (let* ((adjustment (gtk-adjustment-new 0.0 0.0 101.0 0.1 1.0 1.0))
+       (scale (gtk-hscale-new adjustment))
+       (scrollbar (gtk-hscrollbar-new adjustment)))
+    (gtk-widget-set-usize scale 150 30)
+    (gtk-range-set-update-policy scale 'delayed)
+    (gtk-scale-set-digits scale 2)
+    (gtk-scale-set-draw-value scale t)
+    (gtk-box-pack-start window scale t t 0)
+    (gtk-widget-show scale)
+
+    (gtk-range-set-update-policy scrollbar 'continuous)
+    (gtk-box-pack-start window scrollbar t t 0)
+    (gtk-widget-show scrollbar)))
+
+\f
+;;;; Ruler
+'(gtk-define-test
+ "Rulers" gimp rulers nil
+ (let* ((table (gtk-table-new 2 2 nil))
+       (hruler nil)
+       (vruler nil)
+       (ebox (gtk-event-box-new)))
+
+   (gtk-widget-set-usize ebox 300 300)
+   (gtk-widget-set-events ebox '(pointer-motion-mask pointer-motion-hint-mask))
+   (gtk-container-set-border-width ebox 0)
+
+   (gtk-container-add window ebox)
+   (gtk-container-add ebox table)
+   (gtk-widget-show table)
+
+   (setq hruler (gtk-hruler-new))
+   (gtk-ruler-set-metric hruler 'centimeters)
+   (gtk-ruler-set-range hruler 100 0 0 20)
+   (gtk-table-attach table hruler 1 2 0 1 '(expand fill) 'fill 0 0)
+   (gtk-widget-show hruler)
+
+   (setq vruler (gtk-vruler-new))
+   (gtk-ruler-set-range vruler 5 15 0 20)
+   (gtk-table-attach table vruler 0 1 1 2 'fill '(expand fill) 0 0)
+   (gtk-widget-show vruler)
+
+   (gtk-signal-connect 
+    ebox 'motion_notify_event
+    (lambda (object ev data)
+      (gtk-widget-event (car data) ev)
+      (gtk-widget-event (cdr data) ev))
+    (cons hruler vruler))))
+
+\f
+;;;; Toggle button types
+(gtk-define-test
+ "Toggle Buttons" basic toggle-buttons nil
+ (gtk-container-set-border-width window 0)
+ (gtk-test-make-sample-buttons window 'gtk-toggle-button-new-with-label))
+
+(gtk-define-test
+ "Check Buttons" basic check-buttons nil
+ (gtk-container-set-border-width window 0)
+ (gtk-test-make-sample-buttons window 'gtk-check-button-new-with-label))
+
+(gtk-define-test
+ "Radio Buttons" basic radio-buttons nil
+ (gtk-container-set-border-width window 0)
+ (let ((group nil))
+   (gtk-test-make-sample-buttons window
+                                (lambda (label)
+                                  (let ((button (gtk-radio-button-new-with-label group label)))
+                                    (setq group (gtk-radio-button-group button))
+                                    button)))))
+
+\f
+;;;; Button weirdness
+(gtk-define-test
+ "Buttons" basic buttons nil
+ (let ((box1 nil)
+       (box2 nil)
+       (table nil)
+       (buttons nil)
+       (separator nil)
+       (connect-buttons (lambda (button1 button2)
+                         (gtk-signal-connect button1 'clicked
+                                             (lambda (obj data)
+                                               (if (gtk-widget-visible data)
+                                                   (gtk-widget-hide data)
+                                                 (gtk-widget-show data))) button2))))
+
+   (gtk-container-set-border-width window 0)
+
+   (setq box1 (gtk-vbox-new nil 0))
+   (gtk-container-add window box1)
+
+   (setq table (gtk-table-new 3 3 nil))
+   (gtk-table-set-row-spacings table 5)
+   (gtk-table-set-col-spacings table 5)
+   (gtk-container-set-border-width table 10)
+   (gtk-box-pack-start box1 table t t 0)
+
+   (push (gtk-button-new-with-label "button9") buttons)
+   (push (gtk-button-new-with-label "button8") buttons)
+   (push (gtk-button-new-with-label "button7") buttons)
+   (push (gtk-button-new-with-label "button6") buttons)
+   (push (gtk-button-new-with-label "button5") buttons)
+   (push (gtk-button-new-with-label "button4") buttons)
+   (push (gtk-button-new-with-label "button3") buttons)
+   (push (gtk-button-new-with-label "button2") buttons)
+   (push (gtk-button-new-with-label "button1") buttons)
+
+   (funcall connect-buttons (nth 0 buttons) (nth 1 buttons))
+   (funcall connect-buttons (nth 1 buttons) (nth 2 buttons))
+   (funcall connect-buttons (nth 2 buttons) (nth 3 buttons))
+   (funcall connect-buttons (nth 3 buttons) (nth 4 buttons))
+   (funcall connect-buttons (nth 4 buttons) (nth 5 buttons))
+   (funcall connect-buttons (nth 5 buttons) (nth 6 buttons))
+   (funcall connect-buttons (nth 6 buttons) (nth 7 buttons))
+   (funcall connect-buttons (nth 7 buttons) (nth 8 buttons))
+   (funcall connect-buttons (nth 8 buttons) (nth 0 buttons))
+
+   (gtk-table-attach table (nth 0 buttons) 0 1 0 1 '(expand fill) '(expand fill) 0 0)
+   (gtk-table-attach table (nth 1 buttons) 1 2 1 2 '(expand fill) '(expand fill) 0 0)
+   (gtk-table-attach table (nth 2 buttons) 2 3 2 3 '(expand fill) '(expand fill) 0 0)
+   (gtk-table-attach table (nth 3 buttons) 0 1 2 3 '(expand fill) '(expand fill) 0 0)
+   (gtk-table-attach table (nth 4 buttons) 2 3 0 1 '(expand fill) '(expand fill) 0 0)
+   (gtk-table-attach table (nth 5 buttons) 1 2 2 3 '(expand fill) '(expand fill) 0 0)
+   (gtk-table-attach table (nth 6 buttons) 1 2 0 1 '(expand fill) '(expand fill) 0 0)
+   (gtk-table-attach table (nth 7 buttons) 2 3 1 2 '(expand fill) '(expand fill) 0 0)
+   (gtk-table-attach table (nth 8 buttons) 0 1 1 2 '(expand fill) '(expand fill) 0 0)
+   ))
+
+\f
+;;;; Testing labels and underlining
+(gtk-define-test
+ "Labels" basic labels nil
+ (let ((hbox (gtk-hbox-new nil 5))
+       (vbox (gtk-vbox-new nil 5))
+       (frame nil)
+       (label nil))
+   (gtk-container-add window hbox)
+   (gtk-box-pack-start hbox vbox nil nil 0)
+   (gtk-container-set-border-width window 5)
+
+   (setq frame (gtk-frame-new "Normal Label")
+        label (gtk-label-new "This is a Normal label"))
+   (gtk-container-add frame label)
+   (gtk-box-pack-start vbox frame nil nil 0)
+
+   (setq frame (gtk-frame-new "Multi-line Label")
+        label (gtk-label-new "This is a multi-line label.\nSecond line\nThird line"))
+   (gtk-container-add frame label)
+   (gtk-box-pack-start vbox frame nil nil 0)
+
+   (setq frame (gtk-frame-new "Left Justified Label")
+        label (gtk-label-new "This is a Left-Justified\nMulti-line label.\nThird      line"))
+   (gtk-label-set-justify label 'left)
+   (gtk-container-add frame label)
+   (gtk-box-pack-start vbox frame nil nil 0)
+
+   (setq frame (gtk-frame-new "Right Justified Label")
+        label (gtk-label-new "This is a Right-Justified\nMulti-line label.\nFourth line, (j/k)"))
+   (gtk-label-set-justify label 'right)
+   (gtk-container-add frame label)
+   (gtk-box-pack-start vbox frame nil nil 0)
+
+   ;; Start a second row so that we don't make a ridiculously tall window
+   (setq vbox (gtk-vbox-new nil 5))
+   (gtk-box-pack-start hbox vbox nil nil 0)
+
+   (setq frame (gtk-frame-new "Line wrapped label")
+        label (gtk-label-new
+               (concat "This is an example of a line-wrapped label.  It should not be taking "
+                       "up the entire             " ;;; big space to test spacing
+                       "width allocated to it, but automatically wraps the words to fit.  "
+                       "The time has come, for all good men, to come to the aid of their party.  "
+                       "The sixth sheik's six sheep's sick.\n"
+                       "     It supports multiple paragraphs correctly, and  correctly   adds "
+                       "many          extra  spaces. ")))
+   (gtk-label-set-line-wrap label t)
+   (gtk-container-add frame label)
+   (gtk-box-pack-start vbox frame nil nil 0)
+
+   (setq frame (gtk-frame-new "Filled, wrapped label")
+        label (gtk-label-new
+               (concat
+                "This is an example of a line-wrapped, filled label.  It should be taking "
+                "up the entire              width allocated to it.  Here is a seneance to prove "
+                "my point.  Here is another sentence. "
+                "Here comes the sun, do de do de do.\n"
+                "    This is a new paragraph.\n"
+                "    This is another newer, longer, better paragraph.  It is coming to an end, "
+                "unfortunately.")))
+   (gtk-label-set-justify label 'fill)
+   (gtk-label-set-line-wrap label t)
+   (gtk-container-add frame label)
+   (gtk-box-pack-start vbox frame nil nil 0)
+
+   (setq frame (gtk-frame-new "Underlined label")
+        label (gtk-label-new (concat "This label is underlined!\n"
+                                     "This one is underlined in ÆüËܸì¤ÎÆþÍÑquite a funky fashion")))
+   (gtk-label-set-justify label 'left)
+   (gtk-label-set-pattern label "_________________________ _ _________ _ _____ _ __ __  ___ ____ _____")
+   (gtk-container-add frame label)
+   (gtk-box-pack-start vbox frame nil nil 0)))
+
+\f
+;;;; Progress gauges
+(gtk-define-test
+ "Progress bars" basic progress nil
+ (let* ((timer nil)
+       (adj (gtk-adjustment-new 1 0 100 1 1 1))
+       (label (gtk-label-new "progress..."))
+       (pbar (gtk-progress-bar-new-with-adjustment adj))
+       (button nil)
+       (timer (make-itimer)))
+
+   ;; The original test used GTK timers, but XEmacs already has
+   ;; perfectly good timer support, that ends up mapping onto GTK
+   ;; timers anyway, so we'll use those instead.
+   (set-itimer-function
+    timer
+    (lambda (bar adj)
+      (let ((val (gtk-adjustment-value adj)))
+       (setq val (+ 1 (if (>= val 100) 0 val)))
+       (gtk-adjustment-set-value adj val)
+       (gtk-widget-queue-draw bar))))
+
+   (set-itimer-function-arguments timer (list pbar adj))
+   (set-itimer-uses-arguments timer t)
+   (set-itimer-restart timer 0.1)
+   (set-itimer-value timer 0.1)
+   (set-itimer-is-idle timer nil)
+
+   (gtk-progress-set-format-string pbar "%v%%")
+   (gtk-signal-connect pbar 'destroy (lambda (obj timer) 
+                                      (delete-itimer timer)) timer)
+
+   (gtk-misc-set-alignment label 0 0.5)
+   (gtk-box-pack-start window label nil t 0)
+   (gtk-widget-show label)
+   (gtk-widget-set-usize pbar 200 20)
+   (gtk-box-pack-start window pbar t t 0)
+
+   (setq button (gtk-check-button-new-with-label "Show text"))
+   (gtk-box-pack-start window button nil nil 0)
+   (gtk-signal-connect button 'clicked
+                      (lambda (button bar)
+                        (gtk-progress-set-show-text
+                         bar
+                         (gtk-toggle-button-get-active button))) pbar)
+   (gtk-widget-show button)
+
+   (setq button (gtk-check-button-new-with-label "Discrete blocks"))
+   (gtk-box-pack-start window button nil nil 0)
+   (gtk-signal-connect button 'clicked
+                      (lambda (button bar)
+                        (gtk-progress-bar-set-bar-style
+                         bar
+                         (if (gtk-toggle-button-get-active button)
+                             'discrete
+                           'continuous))) pbar)
+   (gtk-widget-show button)
+
+   (gtk-widget-show pbar)
+
+   (activate-itimer timer)))
+
+(gtk-define-test
+ "Gamma Curve" gimp gamma-curve nil
+ (let ((curve (gtk-gamma-curve-new)))
+   (gtk-container-add window curve)
+   (gtk-widget-show-all curve)
+   (gtk-curve-set-range (gtk-gamma-curve-curve curve) 0 255 0 255)
+   (gtk-curve-set-gamma (gtk-gamma-curve-curve curve) 2)))
+
+\f
+;;;; Testing various button boxes and layout strategies.
+(gtk-define-test
+ "Button Box" container button-box nil
+ (let ((main-vbox (gtk-vbox-new nil 0))
+       (vbox (gtk-vbox-new nil 0))
+       (hbox (gtk-hbox-new nil 0))
+       (frame-horz (gtk-frame-new "Horizontal Button Boxes"))
+       (frame-vert (gtk-frame-new "Vertical Button Boxes"))
+       (create-bbox (lambda (horizontal title spacing child-w child-h layout)
+                     (let ((frame (gtk-frame-new title))
+                           (bbox (if horizontal
+                                     (gtk-hbutton-box-new)
+                                   (gtk-vbutton-box-new))))
+                       (gtk-container-set-border-width bbox 5)
+                       (gtk-container-add frame bbox)
+                       (gtk-button-box-set-layout bbox layout)
+                       (gtk-button-box-set-spacing bbox spacing)
+                       (gtk-button-box-set-child-size bbox child-w child-h)
+                       (gtk-container-add bbox (gtk-button-new-with-label "OK"))
+                       (gtk-container-add bbox (gtk-button-new-with-label "Cancel"))
+                       (gtk-container-add bbox (gtk-button-new-with-label "Help"))
+                       frame))))
+
+   (gtk-container-set-border-width window 10)
+   (gtk-container-add window main-vbox)
+
+   (gtk-box-pack-start main-vbox frame-horz t t 10)
+   (gtk-container-set-border-width vbox 10)
+   (gtk-container-add frame-horz vbox)
+
+   (gtk-box-pack-start main-vbox frame-vert t t 10)
+   (gtk-container-set-border-width hbox 10)
+   (gtk-container-add frame-vert hbox)
+
+   (gtk-box-pack-start vbox (funcall create-bbox t "Spread" 40 85 20 'spread) t t 0)
+   (gtk-box-pack-start vbox (funcall create-bbox t "Edge" 40 85 20 'edge) t t 0)
+   (gtk-box-pack-start vbox (funcall create-bbox t "Start" 40 85 20 'start) t t 0)
+   (gtk-box-pack-start vbox (funcall create-bbox t "End" 40 85 20 'end) t t 0)
+
+   (gtk-box-pack-start hbox (funcall create-bbox nil "Spread" 40 85 20 'spread) t t 0)
+   (gtk-box-pack-start hbox (funcall create-bbox nil "Edge" 40 85 20 'edge) t t 0)
+   (gtk-box-pack-start hbox (funcall create-bbox nil "Start" 40 85 20 'start) t t 0)
+   (gtk-box-pack-start hbox (funcall create-bbox nil "End" 40 85 20 'end) t t 0)))
+
+\f
+;;;; Cursors
+'(gtk-define-test
+  "Cursors" cursors nil
+  (let ((cursors '(x-cursor arrow based-arrow-down based-arrow-up boat bogosity
+                           bottom-left-corner bottom-right-corner bottom-side bottom-tee
+                           box-spiral center-ptr circle clock coffee-mug cross cross-reverse
+                           crosshair diamond-cross dot dotbox double-arrow draft-large
+                           draft-small draped-box exchange fleur gobbler gumby hand1 hand2 heart
+                           icon iron-cross left-ptr left-side left-tee leftbutton ll-angle
+                           lr-angle man middlebutton mouse pencil pirate plus question-arrow
+                           right-ptr right-side right-tee rightbutton rtl-logo sailboat
+                           sb-down-arrow sb-h-double-arrow sb-left-arrow sb-right-arrow
+                           sb-up-arrow sb-v-double-arrow shuttle sizing spider spraycan star
+                           target tcross top-left-arrow top-left-corner top-right-corner top-side
+                           top-tee trek ul-angle umbrella ur-angle watch xterm last-cursor))
+       (cursor-area nil)
+       (adjustment nil)
+       (spinner nil))
+    (setq cursor-area (gtk-event-box-new)
+         adjustment (gtk-adjustment-new 0 0 (length cursors) 1 1 1)
+         spinner (gtk-spin-button-new adjustment 1 3))
+    (gtk-widget-set-usize cursor-area 200 100)
+    (gtk-box-pack-start window cursor-area t t 0)
+    (gtk-box-pack-start window spinner nil nil 0)))
+
+\f
+;;;; Toolbar
+(defun gtk-test-toolbar-create ()
+  (let ((toolbar (gtk-toolbar-new 'horizontal 'both)))
+    (gtk-toolbar-set-button-relief toolbar 'none)
+
+    (gtk-toolbar-append-item toolbar
+                            "Horizonal" "Horizontal toolbar layout" "Toolbar/Horizontal"
+                            (gtk-pixmap-new gtk-test-open-glyph nil)
+                            (lambda (tbar)
+                              (gtk-toolbar-set-orientation tbar 'horizontal)) toolbar)
+    (gtk-toolbar-append-item toolbar
+                            "Vertical" "Vertical toolbar layout" "Toolbar/Vertical"
+                            (gtk-pixmap-new gtk-test-open-glyph nil)
+                            (lambda (tbar)
+                              (gtk-toolbar-set-orientation tbar 'vertical)) toolbar)
+
+    (gtk-toolbar-append-space toolbar)
+    (gtk-toolbar-append-item toolbar
+                            "Icons" "Only show toolbar icons" "Toolbar/IconsOnly"
+                            (gtk-pixmap-new gtk-test-open-glyph nil)
+                            (lambda (tbar)
+                              (gtk-toolbar-set-style tbar 'icons)) toolbar)
+    (gtk-toolbar-append-item toolbar
+                            "Text" "Only show toolbar text" "Toolbar/TextOnly"
+                            (gtk-pixmap-new gtk-test-open-glyph nil)
+                            (lambda (tbar)
+                              (gtk-toolbar-set-style tbar 'text)) toolbar)
+    (gtk-toolbar-append-item toolbar
+                            "Both" "Show toolbar icons and text" "Toolbar/Both"
+                            (gtk-pixmap-new gtk-test-open-glyph nil)
+                            (lambda (tbar)
+                              (gtk-toolbar-set-style tbar 'both)) toolbar)
+
+    (gtk-toolbar-append-space toolbar)
+    (gtk-toolbar-append-item toolbar
+                            "Small" "Use small spaces" ""
+                            (gtk-pixmap-new gtk-test-open-glyph nil)
+                            (lambda (tbar)
+                              (gtk-toolbar-set-space-size tbar 5)) toolbar)
+    (gtk-toolbar-append-item toolbar
+                            "Big" "Use big spaces" ""
+                            (gtk-pixmap-new gtk-test-open-glyph nil)
+                            (lambda (tbar)
+                              (gtk-toolbar-set-space-size tbar 10)) toolbar)
+
+    (gtk-toolbar-append-space toolbar)
+    (gtk-toolbar-append-item toolbar
+                            "Enable" "Enable tooltips" ""
+                            (gtk-pixmap-new gtk-test-open-glyph nil)
+                            (lambda (tbar)
+                              (gtk-toolbar-set-tooltips tbar t)) toolbar)
+    (gtk-toolbar-append-item toolbar
+                            "Disable" "Disable tooltips" ""
+                            (gtk-pixmap-new gtk-test-open-glyph nil)
+                            (lambda (tbar)
+                              (gtk-toolbar-set-tooltips tbar nil)) toolbar)
+
+    (gtk-toolbar-append-space toolbar)
+    (gtk-toolbar-append-item toolbar
+                            "Borders" "Show borders" ""
+                            (gtk-pixmap-new gtk-test-open-glyph nil)
+                            (lambda (tbar)
+                              (gtk-toolbar-set-button-relief tbar 'normal)) toolbar)
+    (gtk-toolbar-append-item toolbar
+                            "Borderless" "Hide borders" ""
+                            (gtk-pixmap-new gtk-test-open-glyph nil)
+                            (lambda (tbar)
+                              (gtk-toolbar-set-button-relief tbar 'none)) toolbar)
+
+    (gtk-toolbar-append-space toolbar)
+    (gtk-toolbar-append-item toolbar
+                            "Empty" "Empty spaces" ""
+                            (gtk-pixmap-new gtk-test-open-glyph nil)
+                            (lambda (tbar)
+                              (gtk-toolbar-set-space-style tbar 'empty)) toolbar)
+    (gtk-toolbar-append-item toolbar
+                            "Lines" "Lines in spaces" ""
+                            (gtk-pixmap-new gtk-test-open-glyph nil)
+                            (lambda (tbar)
+                              (gtk-toolbar-set-space-style tbar 'line)) toolbar)
+    (gtk-widget-show-all toolbar)
+    toolbar))
+
+(gtk-define-test
+ "Toolbar" container toolbar nil
+ (gtk-box-pack-start window (gtk-test-toolbar-create) t t 0))
+
+\f
+;;;; Text
+(gtk-define-test
+ "Text" composite text nil
+ (let ((text (gtk-text-new nil nil))
+       (scrolled (gtk-scrolled-window-new nil nil))
+       (bbox (gtk-hbutton-box-new))
+       (button nil))
+   (gtk-box-pack-start window scrolled t t 0)
+   (gtk-box-pack-start window bbox nil nil 0)
+   (gtk-widget-set-usize text 500 500)
+   (gtk-container-add scrolled text)
+
+   (setq button (gtk-check-button-new-with-label "Editable"))
+   (gtk-signal-connect button 'toggled
+                      (lambda (button text)
+                        (gtk-text-set-editable text (gtk-toggle-button-get-active button))) text)
+   (gtk-container-add bbox button)
+
+   (setq button (gtk-check-button-new-with-label "Wrap words"))
+   (gtk-signal-connect button 'toggled
+                      (lambda (button text)
+                        (gtk-text-set-word-wrap text (gtk-toggle-button-get-active button))) text)
+   (gtk-container-add bbox button)
+
+   ;; put some default text in there.
+   (gtk-widget-set-style text 'default)
+   (let ((faces '(blue bold bold-italic gtk-test-face-large red text-cursor))
+        (string nil))
+     (mapc (lambda (face)
+            (setq string (format "Sample text in the `%s' face\n" face))
+            (gtk-text-insert text
+                             (face-font face)
+                             (face-foreground face)
+                             (face-background face)
+                             string (length string))) faces))
+
+
+   ;; Tell the user their rights...
+   (let ((file (locate-data-file "COPYING")))
+     (gtk-text-freeze text)
+     (save-excursion
+       (set-buffer (get-buffer-create " *foo*"))
+       (insert-file-contents file)
+       (gtk-text-insert text nil nil nil (buffer-string) (point-max))
+       (kill-buffer (current-buffer))))
+     (gtk-text-thaw text)))
+
+\f
+;;;; handle box
+(gtk-define-test
+ "Handle box" container handles nil
+ (let ((handle nil)
+       (hbox (gtk-hbox-new nil 0)))
+
+   (gtk-box-pack-start window (gtk-label-new "Above") nil nil 0)
+   (gtk-box-pack-start window (gtk-hseparator-new) nil nil 0)
+   (gtk-box-pack-start window hbox t t 0)
+   (gtk-box-pack-start window (gtk-hseparator-new) nil nil 0)
+   (gtk-box-pack-start window (gtk-label-new "Below") nil nil 0)
+   
+   (setq handle (gtk-handle-box-new))
+   (gtk-container-add handle (gtk-test-toolbar-create))
+   (gtk-widget-show-all handle)
+   (gtk-box-pack-start hbox handle nil nil 0)
+   (gtk-signal-connect handle 'child_attached
+                      (lambda (box child data)
+                        (message "Child widget (%s) attached" child)))
+   (gtk-signal-connect handle 'child_detached
+                      (lambda (box child data)
+                        (message "Child widget (%s) detached" child)))
+
+   (setq handle (gtk-handle-box-new))
+   (gtk-container-add handle (gtk-label-new "Fooo!!!"))
+   (gtk-box-pack-start hbox handle nil nil 0)
+   (gtk-signal-connect handle 'child_attached
+                      (lambda (box child data)
+                        (message "Child widget (%s) attached" child)))
+   (gtk-signal-connect handle 'child_detached
+                      (lambda (box child data)
+                        (message "Child widget (%s) detached" child)))))
+
+\f
+;;;; Menus
+(gtk-define-test
+ "Menus" basic menus nil
+ (let ((menubar (gtk-menu-bar-new))
+       (item nil)
+       (right-justify nil))
+   (gtk-box-pack-start window menubar nil nil 0)
+   (mapc (lambda (menudesc)
+          (if (not menudesc)
+              (setq right-justify t)
+            (setq item (gtk-build-xemacs-menu menudesc))
+            (gtk-widget-show item)
+            (if right-justify
+                (gtk-menu-item-right-justify item))
+            (gtk-menu-bar-append menubar item)))
+        default-menubar)))
+
+\f
+;;;; Spinbutton
+(gtk-define-test
+ "Spinbutton" composite spinbutton nil
+ (let (frame vbox vbox2 hbox label spin adj spin2 button)
+
+   (gtk-container-set-border-width window 5)
+
+   (setq frame (gtk-frame-new "Not accelerated")
+        hbox (gtk-hbox-new nil 0))
+
+   (gtk-box-pack-start window frame t t 0)
+   (gtk-container-add frame hbox)
+
+   (setq vbox (gtk-vbox-new nil 0)
+        label (gtk-label-new "Day:")
+        adj (gtk-adjustment-new 1.0 1.0 31.0 1.0 5.0 0.0)
+        spin (gtk-spin-button-new adj 0 0))
+
+   (gtk-misc-set-alignment label 0 0.5)
+   (gtk-spin-button-set-wrap spin t)
+   (gtk-spin-button-set-shadow-type spin 'out)
+   (gtk-box-pack-start hbox vbox t t 5)
+   (gtk-box-pack-start vbox label nil t 0)
+   (gtk-box-pack-start vbox spin nil t 0)
+
+   (setq vbox (gtk-vbox-new nil 0)
+        label (gtk-label-new "Month:")
+        adj (gtk-adjustment-new 1.0 1.0 12.0 1.0 5.0 0.0)
+        spin (gtk-spin-button-new adj 0 0))
+   (gtk-misc-set-alignment label 0 0.5)
+   (gtk-spin-button-set-wrap spin t)
+   (gtk-spin-button-set-shadow-type spin 'out)
+   (gtk-box-pack-start hbox vbox t t 5)
+   (gtk-box-pack-start vbox label nil t 0)
+   (gtk-box-pack-start vbox spin nil t 0)
+
+   (setq vbox (gtk-vbox-new nil 0)
+        label (gtk-label-new "Year:")
+        adj (gtk-adjustment-new 1998.0 0.0 2100.0 1.0 100.0 0.0)
+        spin (gtk-spin-button-new adj 0 0))
+   (gtk-misc-set-alignment label 0 0.5)
+   (gtk-spin-button-set-wrap spin t)
+   (gtk-spin-button-set-shadow-type spin 'out)
+   (gtk-widget-set-usize spin 55 0)
+   (gtk-box-pack-start hbox vbox t t 5)
+   (gtk-box-pack-start vbox label nil t 0)
+   (gtk-box-pack-start vbox spin nil t 0)
+
+   (setq frame (gtk-frame-new "Accelerated")
+        vbox (gtk-vbox-new nil 0))
+
+   (gtk-box-pack-start window frame t t 0)
+   (gtk-container-add frame vbox)
+
+   (setq hbox (gtk-hbox-new nil 0))
+   (gtk-box-pack-start vbox hbox nil t 5)
+
+   (setq vbox2 (gtk-vbox-new nil 0)
+        label (gtk-label-new "Value:")
+        adj (gtk-adjustment-new 0.0 -10000.0 10000.0 0.5 100.0 0.0)
+        spin (gtk-spin-button-new adj 1.0 2))
+   (gtk-misc-set-alignment label 0 0.5)
+   (gtk-spin-button-set-wrap spin t)
+   (gtk-widget-set-usize spin 100 0)
+   (gtk-box-pack-start vbox2 label nil t 0)
+   (gtk-box-pack-start vbox2 spin nil t 0)
+   (gtk-box-pack-start hbox vbox2 t t 0)
+
+   (setq vbox2 (gtk-vbox-new nil 0)
+        label (gtk-label-new "Digits:")
+        adj (gtk-adjustment-new 2 1 5 1 1 0)
+        spin2 (gtk-spin-button-new adj 0 0))
+   (gtk-misc-set-alignment label 0 0.5)
+   (gtk-spin-button-set-wrap spin2 t)
+   (gtk-widget-set-usize spin2 100 0)
+   (gtk-box-pack-start vbox2 label nil t 0)
+   (gtk-box-pack-start vbox2 spin2 nil t 0)
+   (gtk-box-pack-start hbox vbox2 t t 0)
+   (gtk-signal-connect adj 'value_changed
+                      (lambda (adj spinners)
+                        (gtk-spin-button-set-digits
+                         (car spinners)
+                         (gtk-spin-button-get-value-as-int (cdr spinners))))
+                      (cons spin spin2))
+
+   (setq button (gtk-check-button-new-with-label "Snap to 0.5-ticks"))
+   (gtk-signal-connect button 'clicked
+                      (lambda (button spin)
+                        (gtk-spin-button-set-snap-to-ticks
+                         spin
+                         (gtk-toggle-button-get-active button)))
+                      spin)
+   (gtk-box-pack-start vbox button t t 0)
+   (gtk-toggle-button-set-active button t)
+
+   (setq button (gtk-check-button-new-with-label "Numeric only input mode"))
+   (gtk-signal-connect button 'clicked
+                      (lambda (button spin)
+                        (gtk-spin-button-set-numeric
+                         spin
+                         (gtk-toggle-button-get-active button)))
+                      spin)
+   (gtk-box-pack-start vbox button t t 0)
+   (gtk-toggle-button-set-active button t)
+
+   (setq label (gtk-label-new ""))
+
+   (setq hbox (gtk-hbutton-box-new))
+   (gtk-box-pack-start vbox hbox nil t 5)
+   (gtk-box-pack-start vbox label nil nil 5)
+
+   (setq button (gtk-button-new-with-label "Value as int"))
+   (gtk-container-add hbox button)
+   (gtk-signal-connect button 'clicked
+                      (lambda (obj data)
+                        (let ((spin (car data))
+                              (label (cdr data)))
+                          (gtk-label-set-text label
+                                              (format "%d"
+                                                      (gtk-spin-button-get-value-as-int spin)))))
+                      (cons spin label))
+
+   (setq button (gtk-button-new-with-label "Value as float"))
+   (gtk-container-add hbox button)
+   (gtk-signal-connect button 'clicked
+                      (lambda (obj data)
+                        (let ((spin (car data))
+                              (label (cdr data)))
+                          (gtk-label-set-text label
+                                              (format "%g"
+                                                      (gtk-spin-button-get-value-as-float spin)))))
+                      (cons spin label))))
+
+\f
+;;;; Reparenting
+(gtk-define-test
+ "Reparenting" misc reparenting nil
+ (let ((label (gtk-label-new "Hello World"))
+       (frame-1 (gtk-frame-new "Frame 1"))
+       (frame-2 (gtk-frame-new "Frame 2"))
+       (button nil)
+       (hbox (gtk-hbox-new nil 5))
+       (vbox-1 nil)
+       (vbox-2 nil)
+       (reparent-func (lambda (button data)
+                        (let ((label (car data))
+                              (new-parent (cdr data)))
+                          (gtk-widget-reparent label new-parent)))))
+       
+   (gtk-box-pack-start window hbox t t 0)
+   (gtk-box-pack-start hbox frame-1 t t 0)
+   (gtk-box-pack-start hbox frame-2 t t 0)
+
+   (setq vbox-1 (gtk-vbox-new nil 0))
+   (gtk-container-add frame-1 vbox-1)
+   (setq vbox-2 (gtk-vbox-new nil 0))
+   (gtk-container-add frame-2 vbox-2)
+
+   (setq button (gtk-button-new-with-label "switch"))
+   (gtk-box-pack-start vbox-1 button nil nil 0)
+   (gtk-signal-connect button 'clicked reparent-func (cons label vbox-2))
+   
+   (setq button (gtk-button-new-with-label "switch"))
+   (gtk-box-pack-start vbox-2 button nil nil 0)
+   (gtk-signal-connect button 'clicked reparent-func (cons label vbox-1))
+
+   (gtk-box-pack-start vbox-2 label nil t 0)))
+
+
+;;;; StatusBar
+(defvar statusbar-counter 1)
+
+(gtk-define-test
+ "Statusbar" composite statusbar nil
+ (let ((bar (gtk-statusbar-new))
+       (vbox nil)
+       (button nil))
+
+   (setq vbox (gtk-vbox-new nil 0))
+   (gtk-box-pack-start window vbox t t 0)
+   (gtk-box-pack-end window bar t t 0)
+
+   (setq button (gtk-button-new-with-label "push something"))
+   (gtk-box-pack-start-defaults vbox button)
+   (gtk-signal-connect button 'clicked
+                      (lambda (button bar)
+                        (gtk-statusbar-push bar 1 (format "something %d" (incf statusbar-counter))))
+                      bar)
+
+   (setq button (gtk-button-new-with-label "pop"))
+   (gtk-box-pack-start-defaults vbox button)
+   (gtk-signal-connect button 'clicked
+                      (lambda (button bar)
+                        (gtk-statusbar-pop bar 1)) bar)
+
+   (setq button (gtk-button-new-with-label "steal #4"))
+   (gtk-box-pack-start-defaults vbox button)
+   (gtk-signal-connect button 'clicked
+                      (lambda (button bar)
+                        (gtk-statusbar-remove bar 1 4)) bar)
+
+   (setq button (gtk-button-new-with-label "dump stack"))
+   (gtk-box-pack-start-defaults vbox button)
+   (gtk-widget-set-sensitive button nil)
+
+   (setq button (gtk-button-new-with-label "test contexts"))
+   (gtk-box-pack-start-defaults vbox button)
+   (gtk-signal-connect button 'clicked
+                      (lambda (button bar)
+                        (let ((contexts '("any context" "idle messages" "some text"
+                                          "hit the mouse" "hit the mouse2")))
+                          (message-box "%s"
+                                       (mapconcat
+                                        (lambda (ctx)
+                                          (format "context=\"%s\", context_id=%d"
+                                                  ctx (gtk-statusbar-get-context-id bar ctx)))
+                                        contexts "\n")))) bar)))
+
+\f
+;;;; Columned List
+(gtk-define-test
+ "Columnar List" composite clist nil
+ (let ((titles '("auto resize" "not resizeable" "max width 100" "min width 50"
+                "hide column" "Title 5" "Title 6" "Title 7" "Title 8" "Title 9"
+                "Title 10" "Title 11"))
+       hbox clist button separator scrolled-win check undo-button label)
+
+   (gtk-container-set-border-width window 0)
+
+   (setq scrolled-win (gtk-scrolled-window-new nil nil))
+   (gtk-container-set-border-width scrolled-win 5)
+   (gtk-scrolled-window-set-policy scrolled-win 'automatic 'automatic)
+
+   ;; create GtkCList here so we have a pointer to throw at the 
+   ;; button callbacks -- more is done with it later
+   (setq clist (gtk-clist-new-with-titles (length titles) titles))
+   (gtk-container-add scrolled-win clist)
+
+   ;; Make the columns live up to their titles.
+   (gtk-clist-set-column-auto-resize clist 0 t)
+   (gtk-clist-set-column-resizeable clist 1 nil)
+   (gtk-clist-set-column-max-width clist 2 100)
+   (gtk-clist-set-column-min-width clist 3 50)
+
+   (gtk-signal-connect clist 'click-column
+                      (lambda (clist column data)
+                        (cond
+                         ((= column 4)
+                          (gtk-clist-set-column-visibility clist column nil))
+                         ((= column (gtk-clist-sort-column clist))
+                          (gtk-clist-set-sort-type
+                           clist (if (eq (gtk-clist-sort-type clist) 'ascending)
+                                     'descending
+                                   'ascending)))
+                         (t
+                          (gtk-clist-set-sort-column clist column)))
+                        (gtk-clist-sort clist)))
+
+   ;; control buttons
+   (setq hbox (gtk-hbox-new nil 5))
+   (gtk-container-set-border-width hbox 5)
+   (gtk-box-pack-start window hbox nil nil 0)
+
+   (setq button (gtk-button-new-with-label "Insert Row"))
+   (gtk-box-pack-start hbox button t t 0)
+   (gtk-signal-connect button 'clicked
+                      (lambda (button clist)
+                        (gtk-clist-append clist
+                                          (list (format "CListRow %05d" (random 10000))
+                                                "Column 1"
+                                                "Column 2"
+                                                "Column 3"
+                                                "Column 4"
+                                                "Column 5"
+                                                "Column 6"
+                                                "Column 7"
+                                                "Column 8"
+                                                "Column 0"
+                                                "Column 10"
+                                                "Column 11"))) clist)
+
+   (setq button (gtk-button-new-with-label "Add 1,000 Rows with Pixmaps"))
+   (gtk-box-pack-start hbox button t t 0)
+   (gtk-signal-connect button 'clicked
+                      (lambda (button clist)
+                        (let ((row 0) i)
+                          (gtk-clist-freeze clist)
+                          (loop for i from 0 to 1000 do
+                            (setq row 
+                                  (gtk-clist-append clist
+                                                    (list
+                                                     (format "CListRow %05d" (random 10000))
+                                                     "Column 1"
+                                                     "Column 2"
+                                                     "Column 3"
+                                                     "Column 4"
+                                                     "Column 5"
+                                                     "Column 6"
+                                                     "Column 7"
+                                                     "Column 8"
+                                                     "Column 0"
+                                                     "Column 10"
+                                                     "Column 11")))
+                            (gtk-clist-set-pixtext clist row 3 "gtk+" 5
+                                                   gtk-test-mini-gtk-glyph
+                                                   nil))
+                          (gtk-clist-thaw clist))) clist)
+
+   (setq button (gtk-button-new-with-label "Add 10,000 Rows"))
+   (gtk-box-pack-start hbox button t t 0)
+   (gtk-signal-connect button 'clicked
+                      (lambda (button clist)
+                        (gtk-clist-freeze clist)
+                        (loop for i from 0 to 10000 do
+                          (gtk-clist-append clist
+                                            (list
+                                             (format "CListRow %05d" (random 10000))
+                                             "Column 1"
+                                             "Column 2"
+                                             "Column 3"
+                                             "Column 4"
+                                             "Column 5"
+                                             "Column 6"
+                                             "Column 7"
+                                             "Column 8"
+                                             "Column 0"
+                                             "Column 10"
+                                             "Column 11")))
+                        (gtk-clist-thaw clist)) clist)
+
+   ;; Second layer of buttons
+   (setq hbox (gtk-hbox-new nil 5))
+   (gtk-container-set-border-width hbox 5)
+   (gtk-box-pack-start window hbox nil nil 0)
+
+   (setq button (gtk-button-new-with-label "Clear List"))
+   (gtk-box-pack-start hbox button t t 0)
+   (gtk-signal-connect button 'clicked (lambda (button clist)
+                                        (gtk-clist-clear clist)) clist)
+
+   (setq button (gtk-button-new-with-label "Remove Selection"))
+   (gtk-box-pack-start hbox button t t 0)
+   (gtk-signal-connect button 'clicked (lambda (button clist)
+                                        (error "Do not know how to do this yet.")))
+   (gtk-widget-set-sensitive button nil)
+
+   (setq button (gtk-button-new-with-label "Undo Selection"))
+   (gtk-box-pack-start hbox button t t 0)
+   (gtk-signal-connect button 'clicked
+                      (lambda (button clist) (gtk-clist-undo-selection clist)))
+
+   (setq button (gtk-button-new-with-label "Warning Test"))
+   (gtk-box-pack-start hbox button t t 0)
+   (gtk-signal-connect button 'clicked 'ignore)
+   (gtk-widget-set-sensitive button nil)
+
+   ;; Third layer of buttons
+   (setq hbox (gtk-hbox-new nil 5))
+   (gtk-container-set-border-width hbox 5)
+   (gtk-box-pack-start window hbox nil nil 0)
+
+   (setq button (gtk-check-button-new-with-label "Show Title Buttons"))
+   (gtk-box-pack-start hbox button nil t 0)
+   (gtk-signal-connect button 'clicked (lambda (button clist)
+                                        (if (gtk-toggle-button-get-active button)
+                                            (gtk-clist-column-titles-show clist)
+                                          (gtk-clist-column-titles-hide clist))) clist)
+   (gtk-toggle-button-set-active button t)
+
+   (setq button (gtk-check-button-new-with-label "Reorderable"))
+   (gtk-box-pack-start hbox check nil t 0)
+   (gtk-signal-connect button 'clicked (lambda (button clist)
+                                        (gtk-clist-set-reorderable
+                                         clist
+                                         (gtk-toggle-button-get-active button))) clist)
+   (gtk-toggle-button-set-active button t)
+
+   (setq label (gtk-label-new "Selection Mode :"))
+   (gtk-box-pack-start hbox label nil t 0)
+
+   (gtk-box-pack-start hbox (build-option-menu
+                            '(("Single"   .
+                               (lambda (item clist)
+                                 (gtk-clist-set-selection-mode clist 'single)))
+                              ("Browse"   . 
+                               (lambda (item clist)
+                                 (gtk-clist-set-selection-mode clist 'browse)))
+                              ("Multiple" . 
+                               (lambda (item clist)
+                                 (gtk-clist-set-selection-mode clist 'multiple)))
+                              ("Extended" . 
+                               (lambda (item clist)
+                                 (gtk-clist-set-selection-mode clist 'extended))))
+                            3 clist) nil t 0)
+
+   ;; The rest of the clist configuration
+   (gtk-box-pack-start window scrolled-win t t 0)
+   (gtk-clist-set-row-height clist 18)
+   (gtk-widget-set-usize clist -1 300)
+
+   (loop for i from 0 to 11 do
+     (gtk-clist-set-column-width clist i 80))))
+
+\f
+;;;; Notebook
+(defun set-tab-label (notebook page selected-p)
+  (if page
+      (let (label label-box pixwid)
+       (setq label-box (gtk-hbox-new nil 0))
+       (setq pixwid (gtk-pixmap-new
+                     (if selected-p gtk-test-open-glyph gtk-test-closed-glyph) nil))
+       (gtk-box-pack-start label-box pixwid nil t 0)
+       (gtk-misc-set-padding pixwid 3 1) ;
+       (setq label (gtk-label-new
+                    (format "Page %d" (1+ (gtk-notebook-page-num notebook page)))))
+       (gtk-box-pack-start label-box label nil t 0)
+       (gtk-widget-show-all label-box)
+       (gtk-notebook-set-tab-label notebook page label-box))))
+
+(defun page-switch (widget page page-num data)
+  (let ((oldpage (gtk-notebook-get-current-page widget))
+       (label nil)
+       (label-box nil)
+       (pixwid nil))
+    (if (eq page-num oldpage)
+       nil
+      (set-tab-label widget (gtk-notebook-get-nth-page widget oldpage) nil)
+      (set-tab-label widget (gtk-notebook-get-nth-page widget page-num) t))))
+
+(defun create-pages (notebook start end)
+  (let (child button label hbox vbox label-box menu-box pixwid i)
+    (setq i start)
+    (while (<= i end)
+      (setq child (gtk-frame-new (format "Page %d" i)))
+      (gtk-container-set-border-width child 10)
+
+      (setq vbox (gtk-vbox-new t 0))
+      (gtk-container-set-border-width vbox 10)
+      (gtk-container-add child vbox)
+
+      (setq hbox (gtk-hbox-new t 0))
+      (gtk-box-pack-start vbox hbox nil t 5)
+
+      (setq button (gtk-check-button-new-with-label "Fill Tab"))
+      (gtk-box-pack-start hbox button t t 5)
+      (gtk-toggle-button-set-active button t)
+      (gtk-signal-connect
+       button 'toggled
+       (lambda (button data)
+        (let ((packing (gtk-notebook-query-tab-label-packing (car data) (cdr data))))
+          (gtk-notebook-set-tab-label-packing (car data) (cdr data)
+                                              (nth 0 packing)
+                                              (gtk-toggle-button-get-active button)
+                                              (nth 2 packing))))
+       (cons notebook child))
+
+      (setq button (gtk-check-button-new-with-label "Expand Tab"))
+      (gtk-box-pack-start hbox button t t 5)
+      (gtk-signal-connect
+       button 'toggled
+       (lambda (button data)
+        (let ((packing (gtk-notebook-query-tab-label-packing (car data) (cdr data))))
+          (gtk-notebook-set-tab-label-packing (car data) (cdr data)
+                                              (gtk-toggle-button-get-active button)
+                                              (nth 1 packing) (nth 2 packing))))
+       (cons notebook child))
+
+      (setq button (gtk-check-button-new-with-label "Pack End"))
+      (gtk-box-pack-start hbox button t t 5)
+      (gtk-signal-connect
+       button 'toggled
+       (lambda (button data)
+        (let ((packing (gtk-notebook-query-tab-label-packing (car data) (cdr data))))
+          (gtk-notebook-set-tab-label-packing (car data) (cdr data)
+                                              (nth 0 packing) (nth 1 packing)
+                                              (if (gtk-toggle-button-get-active button) 'end 'start))))
+       (cons notebook child))
+
+      (setq button (gtk-button-new-with-label "Hide Page"))
+      (gtk-box-pack-end vbox button nil nil 5)
+      (gtk-signal-connect button 'clicked
+                         (lambda (ignored child) (gtk-widget-hide child)) child)
+
+      (gtk-widget-show-all child)
+
+      (setq label-box (gtk-hbox-new nil 0))
+      (setq pixwid (gtk-pixmap-new gtk-test-closed-glyph nil))
+      (gtk-box-pack-start label-box pixwid nil t 0)
+      (gtk-misc-set-padding pixwid 3 1);
+      (setq label (gtk-label-new (format "Page %d" i)))
+      (gtk-box-pack-start label-box label nil t 0)
+      (gtk-widget-show-all label-box)
+
+      (setq menu-box (gtk-hbox-new nil 0))
+      (setq pixwid (gtk-pixmap-new gtk-test-closed-glyph nil))
+      (gtk-box-pack-start menu-box pixwid nil t 0)
+      (gtk-misc-set-padding pixwid 3 1)
+      (setq label (gtk-label-new (format "Page %d" i)))
+      (gtk-box-pack-start menu-box label nil t 0)
+      (gtk-widget-show-all menu-box)
+      (gtk-notebook-append-page-menu notebook child label-box menu-box)
+      (incf i))))
+
+(gtk-define-test
+ "Notebook" container notebook nil
+ (let (box1 box2 button separator omenu transparent label sample-notebook)
+   (gtk-container-set-border-width window 0)
+
+   (setq sample-notebook (gtk-notebook-new))
+   (gtk-signal-connect sample-notebook 'switch_page 'page-switch)
+   (gtk-notebook-set-tab-pos sample-notebook 'top)
+   (gtk-box-pack-start window sample-notebook t t 0)
+   (gtk-container-set-border-width sample-notebook 10)
+
+   (create-pages sample-notebook 1 5)
+
+   (setq separator (gtk-hseparator-new))
+   (gtk-box-pack-start window separator nil t 10)
+
+   (setq box2 (gtk-hbox-new nil 5))
+   (gtk-container-set-border-width box2 10)
+   (gtk-box-pack-start window box2 nil t 0)
+
+   (setq button (gtk-check-button-new-with-label "popup menu"))
+   (gtk-box-pack-start box2 button t nil 0)
+   (gtk-signal-connect button 'clicked
+                      (lambda (button notebook)
+                        (if (gtk-toggle-button-get-active button)
+                            (gtk-notebook-popup-enable notebook)
+                          (gtk-notebook-popup-disable notebook))) sample-notebook)
+
+   (setq button (gtk-check-button-new-with-label "homogeneous tabs"))
+   (gtk-box-pack-start box2 button t nil 0)
+   (gtk-signal-connect button 'clicked
+                      (lambda (button notebook)
+                        (gtk-notebook-set-homogeneous-tabs
+                         notebook
+                         (gtk-toggle-button-get-active button))) sample-notebook)
+
+   (setq box2 (gtk-hbox-new nil 5))
+   (gtk-container-set-border-width box2 10)
+   (gtk-box-pack-start window box2 nil t 0)
+
+   (setq label (gtk-label-new "Notebook Style :"))
+   (gtk-box-pack-start box2 label nil t 0)
+
+   (setq omenu (build-option-menu '(("Standard" .
+                                    (lambda (b n)
+                                      (gtk-notebook-set-show-tabs n t)
+                                      (gtk-notebook-set-scrollable n nil)))
+                                   ("No tabs"  .
+                                    (lambda (b n)
+                                      (gtk-notebook-set-show-tabs n nil)))
+                                   ("Scrollable" .
+                                    (lambda (b n)
+                                      (gtk-notebook-set-show-tabs n t)
+                                      (gtk-notebook-set-scrollable n t))))
+                                 0
+                                 sample-notebook))
+   (gtk-box-pack-start box2 omenu nil t 0)
+
+   (setq button (gtk-button-new-with-label "Show all pages"))
+   (gtk-box-pack-start box2 button nil t 0)
+   (gtk-signal-connect
+    button 'clicked (lambda (button notebook)
+                     (mapc 'gtk-widget-show (gtk-container-children notebook)))
+    sample-notebook)
+
+   (setq box2 (gtk-hbox-new t 10))
+   (gtk-container-set-border-width box2 10)
+   (gtk-box-pack-start window box2 nil t 0)
+
+   (setq button (gtk-button-new-with-label "prev"))
+   (gtk-signal-connect button 'clicked
+                      (lambda (button notebook)
+                        (gtk-notebook-prev-page notebook)) sample-notebook)
+   (gtk-box-pack-start box2 button t t 0)
+
+   (setq button (gtk-button-new-with-label "next"))
+   (gtk-signal-connect button 'clicked
+                      (lambda (button notebook)
+                        (gtk-notebook-next-page notebook)) sample-notebook)
+   (gtk-box-pack-start box2 button t t 0)
+
+   (setq button (gtk-button-new-with-label "rotate"))
+   (gtk-signal-connect button 'clicked
+                      (lambda (button notebook)
+                        (gtk-notebook-set-tab-pos
+                         notebook
+                         (case (gtk-notebook-tab-pos notebook)
+                          (top 'right)
+                          (right 'bottom)
+                          (bottom 'left)
+                          (left 'top))))
+                      sample-notebook)
+
+   (gtk-box-pack-start box2 button t t 0)))
+
+\f
+;;;; Glade interfaces
+(if (and (featurep 'glade)
+        (file-exists-p (expand-file-name "gtk-test.glade" (gtk-test-directory))))
+  (gtk-define-test
+   "Glade Interface" misc libglade t
+   (glade-init)
+   (glade-xml-get-type)
+   (let ((xml (glade-xml-new (expand-file-name "gtk-test.glade" (gtk-test-directory))
+                            nil)))
+     (setq window (glade-xml-get-widget xml "main_window"))
+     (glade-xml-signal-autoconnect xml)))
+  (fmakunbound 'gtk-test-libglade))
+
+\f
+;;;; CTree
+(defvar gtk-test-ctree-hash nil)
+
+(defun gtk-test-ctree-expand-directory (ctree dir parent)
+  (ignore-errors
+    (let ((dirs (directory-files dir t nil nil 5))
+         (files (directory-files dir t nil nil t))
+         (node nil))
+      (mapc (lambda (d)
+             (if (or (string-match "/\\.$" d)
+                     (string-match "/\\.\\.$" d))
+                 nil
+               (setq node
+                     (gtk-ctree-insert-node ctree parent nil
+                                            (list (file-name-nondirectory d) "")
+                                            0 nil nil nil nil nil t))
+               (puthash node d gtk-test-ctree-hash)
+               (gtk-ctree-insert-node ctree node nil
+                                      (list "" "")
+                                      0 nil nil nil nil nil nil)
+               (gtk-ctree-collapse ctree node)))
+           dirs)
+      (mapc (lambda (f)
+             (gtk-ctree-insert-node ctree parent nil
+                                    (list (file-name-nondirectory f)
+                                          (user-login-name (nth 2 (file-attributes f))))
+                                    0 nil nil nil nil t nil))
+           files)
+      (gtk-clist-columns-autosize ctree))))
+
+(defun gtk-spin-button-new-with-label (label adjustment climb-rate digits)
+  (let ((box (gtk-hbox-new nil 2))
+       (spin (gtk-spin-button-new adjustment climb-rate digits))
+       (lbl (gtk-label-new label)))
+    (gtk-box-pack-start box lbl nil nil 0)
+    (gtk-box-pack-start box spin t t 0)
+    (cons box spin)))
+
+(gtk-define-test
+ "Columnar Tree" composite ctree nil
+ (let ((scrolled (gtk-scrolled-window-new nil nil))
+       (ctree (gtk-ctree-new-with-titles 2 0 '("File" "Owner")))
+       (box (gtk-hbutton-box-new))
+       (button nil))
+   (setq gtk-test-ctree-hash (make-hash-table :test 'equal))
+   (put scrolled 'child ctree)
+   (put scrolled 'height 400)
+   (put ctree 'line_style 'solid)
+   (put ctree 'expander_style 'square)
+
+   (gtk-box-pack-start window scrolled t t 0)
+   (gtk-box-pack-start window box nil nil 5)
+
+   (gtk-clist-freeze ctree)
+   (gtk-test-ctree-expand-directory ctree "/" nil)
+   (gtk-clist-thaw ctree)
+
+   (setq button (gtk-button-new-with-label "Expand all"))
+   (put box 'child button)
+   (gtk-signal-connect button 'clicked (lambda (button tree)
+                                        (gtk-ctree-expand-recursive tree nil)) ctree)
+
+   (setq button (gtk-button-new-with-label "Collaps all"))
+   (put box 'child button)
+   (gtk-signal-connect button 'clicked (lambda (button tree)
+                                        (gtk-ctree-collapse-recursive tree nil)) ctree)
+
+   (setq button (gtk-button-new-with-label "Change style"))
+   (put box 'child button)
+   (put button 'sensitive nil)
+
+   (setq box (gtk-hbox-new t 5))
+   (gtk-box-pack-start window box nil nil 0)
+
+   (setq button (gtk-button-new-with-label "Select all"))
+   (put box 'child button)
+   (gtk-signal-connect button 'clicked (lambda (button tree)
+                                        (gtk-ctree-select-recursive tree nil)) ctree)
+
+   (setq button (gtk-button-new-with-label "Unselect all"))
+   (put box 'child button)
+   (gtk-signal-connect button 'clicked (lambda (button tree)
+                                        (gtk-ctree-unselect-recursive tree nil)) ctree)
+
+   (setq button (gtk-button-new-with-label "Remove all"))
+   (put box 'child button)
+   (gtk-signal-connect button 'clicked (lambda (button tree)
+                                        (gtk-clist-freeze tree)
+                                        (gtk-ctree-recurse
+                                         tree nil
+                                         (lambda (tree subnode data)
+                                           (gtk-ctree-remove-node tree subnode)))
+                                        (gtk-clist-thaw tree)) ctree)
+
+   (setq button (gtk-check-button-new-with-label "Reorderable"))
+   (put box 'child button)
+   (gtk-signal-connect button 'clicked (lambda (button tree)
+                                        (put tree 'reorderable
+                                             (gtk-toggle-button-get-active button))) ctree)
+
+   (setq box (gtk-hbox-new t 5))
+   (gtk-box-pack-start window box nil nil 0)
+
+   (gtk-box-pack-start box (build-option-menu
+                           '(("Dotted" . (lambda (item ctree) (put ctree 'line_style 'dotted)))
+                             ("Solid"  . (lambda (item ctree) (put ctree 'line_style 'solid)))
+                             ("Tabbed" . (lambda (item ctree) (put ctree 'line_style 'tabbed)))
+                             ("None"   . (lambda (item ctree) (put ctree 'line_style 'none))))
+                           0 ctree) nil t 0)
+   (gtk-box-pack-start box (build-option-menu
+                           '(("Square"   . (lambda (item ctree) (put ctree 'expander_style 'square)))
+                             ("Triangle" . (lambda (item ctree) (put ctree 'expander_style 'triangle)))
+                             ("Circular" . (lambda (item ctree) (put ctree 'expander_style 'circular)))
+                             ("None"     . (lambda (item ctree) (put ctree 'expander_style 'none))))
+                           0 ctree) nil t 0)
+   (gtk-box-pack-start box (build-option-menu
+                           '(("Left" . (lambda (item ctree)
+                                         (gtk-clist-set-column-justification
+                                          ctree (get ctree 'tree_column) 'left)))
+                             ("Right" . (lambda (item ctree)
+                                          (gtk-clist-set-column-justification
+                                           ctree (get ctree 'tree_column) 'right))))
+                           0 ctree) nil t 0)
+   (gtk-box-pack-start box (build-option-menu
+                           '(("Single"   .
+                              (lambda (item clist)
+                                (gtk-clist-set-selection-mode clist 'single)))
+                             ("Browse"   . 
+                              (lambda (item clist)
+                                (gtk-clist-set-selection-mode clist 'browse)))
+                             ("Multiple" . 
+                              (lambda (item clist)
+                                (gtk-clist-set-selection-mode clist 'multiple)))
+                             ("Extended" . 
+                              (lambda (item clist)
+                                (gtk-clist-set-selection-mode clist 'extended))))
+                           3 ctree) nil t 0)
+
+   (setq box (gtk-hbox-new t 5))
+   (gtk-box-pack-start window box nil nil 0)
+
+   (let (adj spinner)
+     (setq adj (gtk-adjustment-new (get ctree 'indent) 0 999 1 5 5)
+          spinner (gtk-spin-button-new-with-label "Indent: " adj 1 3))
+     (put box 'child (car spinner))
+     (gtk-signal-connect adj 'value-changed
+                        (lambda (adj tree)
+                          (put tree 'indent (truncate (gtk-adjustment-value adj)))) ctree)
+
+     (setq adj (gtk-adjustment-new (get ctree 'spacing) 0 999 1 5 5)
+          spinner (gtk-spin-button-new-with-label "Spacing: " adj 1 3))
+     (put box 'child (car spinner))
+     (gtk-signal-connect adj 'value-changed
+                        (lambda (adj tree)
+                          (put tree 'spacing (truncate (gtk-adjustment-value adj)))) ctree)
+
+     (setq adj (gtk-adjustment-new (get ctree 'row_height) 0 999 1 5 5)
+          spinner (gtk-spin-button-new-with-label "Row Height: " adj 1 3))
+     (put box 'child (car spinner))
+     (gtk-signal-connect adj 'value-changed
+                        (lambda (adj tree)
+                          (put tree 'row_height (truncate (gtk-adjustment-value adj)))) ctree)
+
+     (setq button (gtk-check-button-new-with-label "Show logical root"))
+     (put box 'child button)
+     (gtk-signal-connect button 'clicked
+                        (lambda (button tree)
+                          (put tree 'show_stub (gtk-toggle-button-get-active button))) ctree))
+
+   (gtk-signal-connect ctree 'tree-expand
+                      (lambda (ctree node user-data)
+                        (gtk-clist-freeze ctree)
+                        (gtk-ctree-recurse
+                         ctree node
+                         (lambda (tree subnode user-data)
+                           (if (not (equal subnode node))
+                               (gtk-ctree-remove-node tree subnode))))
+                        (gtk-test-ctree-expand-directory ctree
+                                                         (gethash node gtk-test-ctree-hash)
+                                                         node)
+                        (gtk-clist-thaw ctree)))))
+
+\f
+;;;; The main interface 
+
+(defun gtk-test-view-source (test)
+  ;; View the source for this test in a XEmacs window.
+  (if test
+      (let ((path (expand-file-name "gtk-test.el" (gtk-test-directory))))
+       (if (not (file-exists-p path))
+           (error "Could not find source for gtk-test.el"))
+       (find-file path)
+       (widen)
+       (goto-char (point-min))
+       (if (not (re-search-forward (concat "(gtk-define-test[ \t\n]*\"" test "\"") nil t))
+           (error "Could not find test: %s" test)
+         (narrow-to-page)
+         (goto-char (point-min))))))
+
+(defvar gtk-test-selected-test nil)
+
+(defun gtk-test ()
+  (interactive)
+  (let ((items nil)
+       (box nil)
+       (window nil)
+       (category-trees nil)
+       (tree nil)
+       (pane nil)
+       (scrolled nil)
+       (src-button nil)
+       (gc-button nil)
+       (standalone-p (not (default-gtk-device)))
+       (close-button nil))
+    (gtk-init (list invocation-name))
+    (if standalone-p
+       (progn
+         (gtk-object-destroy (gtk-adjustment-new 0 0 0 0 0 0))))
+    (ignore-errors
+      (or (fboundp 'gtk-test-gnome-pixmaps)
+         (load-file (expand-file-name "gnome-test.el" (gtk-test-directory))))
+      (or (fboundp 'gtk-test-color-combo)
+         (load-file (expand-file-name "gtk-extra-test.el" (gtk-test-directory)))))
+    (unwind-protect
+       (progn
+         (setq window (gtk-dialog-new)
+               box (gtk-vbox-new nil 5)
+               pane (gtk-hpaned-new)
+               scrolled (gtk-scrolled-window-new nil nil)
+               tree (gtk-tree-new)
+               src-button (gtk-button-new-with-label "View source")
+               gc-button (gtk-button-new-with-label "Garbage Collect")
+               close-button (gtk-button-new-with-label "Quit"))
+         (gtk-window-set-title window
+                               (format "%s/GTK %d.%d.%d"
+                                       (if (featurep 'infodock) "InfoDock" "XEmacs")
+                                       emacs-major-version emacs-minor-version
+                                       (or emacs-patch-level emacs-beta-version)))
+
+         (gtk-scrolled-window-set-policy scrolled 'automatic 'automatic)
+         (gtk-scrolled-window-add-with-viewport scrolled tree)
+         (gtk-widget-set-usize scrolled 200 600)
+
+         (gtk-box-pack-start (gtk-dialog-vbox window) pane t t 5)
+         (gtk-paned-pack1 pane scrolled t nil)
+         (gtk-paned-pack2 pane box t nil)
+         (setq gtk-test-shell box)
+         (gtk-widget-show-all box)
+
+         (gtk-container-add (gtk-dialog-action-area window) close-button)
+         (gtk-container-add (gtk-dialog-action-area window) src-button)
+         (gtk-container-add (gtk-dialog-action-area window) gc-button)
+
+         (gtk-signal-connect gc-button 'clicked
+                             (lambda (obj data)
+                               (garbage-collect)))
+         (gtk-signal-connect close-button 'clicked
+                             (lambda (obj data)
+                               (gtk-widget-destroy data)) window)
+         (gtk-signal-connect src-button 'clicked
+                             (lambda (obj data)
+                               (gtk-test-view-source gtk-test-selected-test)))
+
+         ;; Try to be a nice person and sort the tests
+         (setq gtk-defined-tests
+               (sort gtk-defined-tests
+                     (lambda (a b)
+                       (string-lessp (car a) (car b)))))
+
+         ;; This adds all of the buttons to the window.
+         (mapcar (lambda (test)
+                   (let* ((desc (nth 0 test))
+                          (type (nth 1 test))
+                          (func (nth 2 test))
+                          (parent (cdr-safe (assoc type category-trees)))
+                          (item (gtk-tree-item-new-with-label desc)))
+                     (put item 'test-function func)
+                     (put item 'test-description desc)
+                     (put item 'test-type type)
+                     (gtk-widget-show item)
+                     (if (not parent)
+                         (let ((subtree (gtk-tree-new)))
+                           (setq parent (gtk-tree-item-new-with-label
+                                         (or (cdr-safe (assoc type gtk-test-categories))
+                                             (symbol-name type))))
+                           (gtk-signal-connect subtree 'select-child
+                                               (lambda (tree widget data)
+                                                 (setq gtk-test-selected-test (get widget 'test-description))
+                                                 (funcall (get widget 'test-function))))
+                           (gtk-tree-append tree parent)
+                           (gtk-tree-item-set-subtree parent subtree)
+                           (setq parent subtree)
+                           (push (cons type parent) category-trees)))
+                     (gtk-tree-append parent item)))
+                 gtk-defined-tests)
+         (gtk-widget-show-all window)
+         (if standalone-p
+             (progn
+               (gtk-signal-connect window 'destroy (lambda (w d)
+                                                     (gtk-main-quit)))
+               (gtk-main)))))))

diff --git a/tests/gtk/gtk-test.glade b/tests/gtk/gtk-test.glade
new file mode 100644 (file)
index 0000000..0e2760c
--- /dev/null
+++ b/tests/gtk/gtk-test.glade
@@ -0,0 +1,145 @@
+<?xml version="1.0"?>
+<GTK-Interface>
+
+<project>
+  <name>Project1</name>
+  <program_name>project1</program_name>
+  <directory></directory>
+  <source_directory>src</source_directory>
+  <pixmaps_directory>pixmaps</pixmaps_directory>
+  <language>C</language>
+  <gnome_support>True</gnome_support>
+  <gettext_support>True</gettext_support>
+</project>
+
+<widget>
+  <class>GtkWindow</class>
+  <name>main_window</name>
+  <title>Glade Created Window</title>
+  <type>GTK_WINDOW_TOPLEVEL</type>
+  <position>GTK_WIN_POS_NONE</position>
+  <modal>False</modal>
+  <allow_shrink>False</allow_shrink>
+  <allow_grow>True</allow_grow>
+  <auto_shrink>False</auto_shrink>
+
+  <widget>
+    <class>GtkVBox</class>
+    <name>Container</name>
+    <homogeneous>False</homogeneous>
+    <spacing>0</spacing>
+
+    <widget>
+      <class>GtkToolbar</class>
+      <name>toolbar1</name>
+      <orientation>GTK_ORIENTATION_HORIZONTAL</orientation>
+      <type>GTK_TOOLBAR_BOTH</type>
+      <space_size>5</space_size>
+      <space_style>GTK_TOOLBAR_SPACE_EMPTY</space_style>
+      <relief>GTK_RELIEF_NORMAL</relief>
+      <tooltips>True</tooltips>
+      <child>
+       <padding>0</padding>
+       <expand>False</expand>
+       <fill>False</fill>
+      </child>
+
+      <widget>
+       <class>GtkButton</class>
+       <child_name>Toolbar:button</child_name>
+       <name>button1</name>
+       <label>button1</label>
+      </widget>
+
+      <widget>
+       <class>GtkButton</class>
+       <child_name>Toolbar:button</child_name>
+       <name>button2</name>
+       <label>button2</label>
+      </widget>
+
+      <widget>
+       <class>GtkButton</class>
+       <child_name>Toolbar:button</child_name>
+       <name>button3</name>
+       <label>button3</label>
+      </widget>
+    </widget>
+
+    <widget>
+      <class>GtkScrolledWindow</class>
+      <name>scrolledwindow1</name>
+      <hscrollbar_policy>GTK_POLICY_ALWAYS</hscrollbar_policy>
+      <vscrollbar_policy>GTK_POLICY_ALWAYS</vscrollbar_policy>
+      <hupdate_policy>GTK_UPDATE_CONTINUOUS</hupdate_policy>
+      <vupdate_policy>GTK_UPDATE_CONTINUOUS</vupdate_policy>
+      <child>
+       <padding>0</padding>
+       <expand>True</expand>
+       <fill>True</fill>
+      </child>
+
+      <widget>
+       <class>GtkCTree</class>
+       <name>ctree</name>
+       <can_focus>True</can_focus>
+       <columns>3</columns>
+       <column_widths>114,80,80</column_widths>
+       <selection_mode>GTK_SELECTION_SINGLE</selection_mode>
+       <show_titles>True</show_titles>
+       <shadow_type>GTK_SHADOW_IN</shadow_type>
+
+       <widget>
+         <class>GtkLabel</class>
+         <child_name>CTree:title</child_name>
+         <name>label1</name>
+         <label>Tree</label>
+         <justify>GTK_JUSTIFY_CENTER</justify>
+         <wrap>False</wrap>
+         <xalign>2.98023e-08</xalign>
+         <yalign>0.5</yalign>
+         <xpad>0</xpad>
+         <ypad>0</ypad>
+       </widget>
+
+       <widget>
+         <class>GtkLabel</class>
+         <child_name>CTree:title</child_name>
+         <name>label2</name>
+         <label>Header #1</label>
+         <justify>GTK_JUSTIFY_CENTER</justify>
+         <wrap>False</wrap>
+         <xalign>0.5</xalign>
+         <yalign>0.5</yalign>
+         <xpad>0</xpad>
+         <ypad>0</ypad>
+       </widget>
+
+       <widget>
+         <class>GtkLabel</class>
+         <child_name>CTree:title</child_name>
+         <name>label3</name>
+         <label>Header #2</label>
+         <justify>GTK_JUSTIFY_CENTER</justify>
+         <wrap>False</wrap>
+         <xalign>0.5</xalign>
+         <yalign>0.5</yalign>
+         <xpad>0</xpad>
+         <ypad>0</ypad>
+       </widget>
+      </widget>
+    </widget>
+
+    <widget>
+      <class>GtkStatusbar</class>
+      <name>statusbar</name>
+      <child>
+       <padding>0</padding>
+       <expand>False</expand>
+       <fill>False</fill>
+      </child>
+    </widget>
+  </widget>
+</widget>
+
+</GTK-Interface>

diff --git a/tests/gtk/statusbar-test.el b/tests/gtk/statusbar-test.el
new file mode 100644 (file)
index 0000000..457e5d8
--- /dev/null
+++ b/tests/gtk/statusbar-test.el
@@ -0,0 +1,74 @@
+(defvar statusbar-hashtable (make-hashtable 29))
+(defvar statusbar-gnome-p nil)
+
+(defmacro get-frame-statusbar (frame)
+  `(gethash (or ,frame (selected-frame)) statusbar-hashtable))
+
+(defun add-frame-statusbar (frame)
+  "Stick a GTK (or GNOME) statusbar at the bottom of the frame."
+  (if (windowp (frame-property frame 'minibuffer))
+      (puthash frame (get-frame-statusbar (window-frame (frame-property frame 'minibuffer)))
+              statusbar-hashtable)
+    (let ((sbar nil)
+         (shell (frame-property frame 'shell-widget)))
+      (if (string-match "Gnome" (gtk-type-name (gtk-object-type shell)))
+         (progn
+           (require 'gnome-widgets)
+           (setq sbar (gnome-appbar-new t t 0)
+                 statusbar-gnome-p t)
+           (gtk-progress-set-format-string sbar "%p%%")
+           (gnome-app-set-statusbar shell sbar))
+       (setq sbar (gtk-statusbar-new))
+       (gtk-box-pack-end (frame-property frame 'container-widget)
+                         sbar nil nil 0))
+      (puthash frame sbar statusbar-hashtable))))
+
+(add-hook 'create-frame-hook 'add-frame-statusbar)
+(add-hook 'delete-frame-hook (lambda (f)
+                              (remhash f statusbar-hashtable)))
+                              
+
+(defun clear-message (&optional label frame stdout-p no-restore)
+  (let ((sbar (get-frame-statusbar frame)))
+    (if sbar
+       (if statusbar-gnome-p
+           (gnome-appbar-pop sbar)
+         (gtk-statusbar-pop sbar 1)))))
+
+(defun append-message (label message &optional frame stdout-p)
+  (let ((sbar (get-frame-statusbar frame)))
+    (if sbar
+       (if statusbar-gnome-p
+           (gnome-appbar-push sbar message)
+         (gtk-statusbar-push sbar 1 message)))))
+
+(defun progress-display (fmt &optional value &rest args)
+  "Print a progress gauge and message in the bottom gutter area of the frame.
+The arguments are the same as to `format'.
+
+If the only argument is nil, clear any existing progress gauge."
+  (let ((sbar (get-frame-statusbar nil)))
+    (apply 'message fmt args)
+    (if statusbar-gnome-p
+       (progn
+         (gtk-progress-set-show-text (gnome-appbar-get-progress sbar) t)
+         (gnome-appbar-set-progress sbar (/ value 100.0))
+         (gdk-flush)))))
+
+(defun lprogress-display (label fmt &optional value &rest args)
+  "Print a progress gauge and message in the bottom gutter area of the frame.
+First argument LABEL is an identifier for this progress gauge.  The rest of the
+arguments are the same as to `format'."
+    (if (and (null fmt) (null args))
+       (prog1 nil
+         (clear-progress-display label nil))
+      (let ((str (apply 'format fmt args)))
+       (progress-display str value)
+       str)))
+
+(defun clear-progress-display (&rest ignored)
+  (if statusbar-gnome-p
+      (let* ((sbar (get-frame-statusbar nil))
+            (progress (gnome-appbar-get-progress sbar)))
+       (gnome-appbar-set-progress sbar 0)
+       (gtk-progress-set-show-text progress nil))))

diff --git a/tests/gtk/toolbar-test.el b/tests/gtk/toolbar-test.el
new file mode 100644 (file)
index 0000000..f006bd4
--- /dev/null
+++ b/tests/gtk/toolbar-test.el
@@ -0,0 +1,34 @@
+(require 'gtk-widgets)
+(require 'gnome-widgets)
+
+(defvar gnomeified-toolbar
+  ;; [CAPTION TOOLTIP ICON CALLBACK ENABLED]
+  '(["Open" "Open a file" new toolbar-open t]
+    ["Dired" "Edit a directory" open toolbar-dired t]
+    ["Save" "Save buffer" save toolbar-save t]
+    ["Print" "Print Buffer" print toolbar-print t]
+    ["Cut" "Kill region" cut toolbar-cut t]
+    ["Copy" "Copy region" copy toolbar-copy t]
+    ["Paste" "Paste from clipboard" paste toolbar-paste t]
+    ["Undo" "Undo edit" undo toolbar-undo t]
+    ["Spell" "Check spelling" spellcheck toolbar-ispell t]
+    ["Replace" "Search & Replace" srchrpl toolbar-replace t]
+    ["Mail" "Read mail" mail toolbar-mail t]
+    ; info
+    ; compile
+    ; debug
+    ; news
+    ))
+
+(setq x (gtk-toolbar-new 'horizontal 'both))
+(gnome-app-set-toolbar (frame-property nil 'shell-widget) x)
+
+(mapc (lambda (descr)
+       (gtk-toolbar-append-item x
+                                (aref descr 0)
+                                (aref descr 1)
+                                ""
+                                (gnome-stock-pixmap-widget-new x (aref descr 2))
+                                `(lambda (&rest ignored)
+                                   (,(aref descr 3)))))
+      gnomeified-toolbar)

diff --git a/tests/gtk/xemacs-toolbar.el b/tests/gtk/xemacs-toolbar.el
new file mode 100644 (file)
index 0000000..eef5265
--- /dev/null
+++ b/tests/gtk/xemacs-toolbar.el
@@ -0,0 +1,21 @@
+(defvar gtk-torture-test-toolbar-open-active-p t)
+
+(defvar gtk-torture-test-toolbar
+  '([toolbar-file-icon
+     (lambda ()
+       (setq gtk-torture-test-toolbar-open-active-p (not gtk-torture-test-toolbar-open-active-p)))
+     gtk-torture-test-toolbar-open-active-p
+     "Dynamic enabled-p slot... broken in XEmacs 21.1.x"]
+    [:size 35 :style 3d]
+    [toolbar-folder-icon toolbar-dired t "Edit a directory"]
+    [:size 35 :style 2d]
+    [toolbar-news-icon toolbar-news t "Read news"]
+    nil
+    [toolbar-info-icon toolbar-info t "Info documentation"]
+    ))
+
+(defun gtk-torture-test-toolbar ()
+  (interactive)
+  (switch-to-buffer (get-buffer-create "Toolbar testing"))
+  (set-specifier default-toolbar gtk-torture-test-toolbar (current-buffer))
+  (set-specifier default-toolbar-visible-p t (current-buffer)))