--- /dev/null
+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.)
+
--- /dev/null
+;; -*- 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
+; )
--- /dev/null
+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.
+
+
--- /dev/null
+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.
+
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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")))))))
+)
--- /dev/null
+;;; 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))
--- /dev/null
+;;; 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)
--- /dev/null
+(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)
--- /dev/null
+(require 'gtk-iso8859-1)
+(require 'x-compose)
+
+(provide 'gtk-compose)
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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)))
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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)
--- /dev/null
+;; 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
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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))))))
--- /dev/null
+;; 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)
--- /dev/null
+(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"))
--- /dev/null
+;;; 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)))
--- /dev/null
+;; 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)))
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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)
--- /dev/null
+(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))
+
+ )
--- /dev/null
+;;; 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)
--- /dev/null
+(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)))
--- /dev/null
+;;; 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)
--- /dev/null
+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.
+
--- /dev/null
+/* 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);
+}
--- /dev/null
+/* 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_ */
--- /dev/null
+/* 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 ());
+}
--- /dev/null
+/* 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"));
+}
--- /dev/null
+#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);
+}
--- /dev/null
+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);
+}
--- /dev/null
+/* 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", >k_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);
+ }
+}
--- /dev/null
+/* 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;
+}
--- /dev/null
+/* 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;
+}
--- /dev/null
+/* 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_ */
--- /dev/null
+/* 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
--- /dev/null
+/* 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;
+ }
+}
+
--- /dev/null
+/* 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_ */
--- /dev/null
+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);
+}
--- /dev/null
+/* 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));
+}
--- /dev/null
+/* 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__ */
--- /dev/null
+/* 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 */
+}
--- /dev/null
+/* 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_ */
--- /dev/null
+/* 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 ();
+}
--- /dev/null
+/* 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);
+}
--- /dev/null
+/* 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;
+}
--- /dev/null
+/* 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_ */
--- /dev/null
+/* 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);
+}
--- /dev/null
+/* 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"));
+}
--- /dev/null
+/* 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_ */
--- /dev/null
+/* 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;
+}
--- /dev/null
+/* 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);
+}
--- /dev/null
+/* 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);
+}
--- /dev/null
+/* 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));
+}
--- /dev/null
+/* 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__ */
--- /dev/null
+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
--- /dev/null
+;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.
--- /dev/null
+(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)))
--- /dev/null
+(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))))
--- /dev/null
+(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)))
+
--- /dev/null
+;;; 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)))))))
--- /dev/null
+<?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>
--- /dev/null
+(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))))
--- /dev/null
+(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)
--- /dev/null
+(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)))
projects / chise / xemacs-chise.git- / commitdiff