+++ /dev/null
-# Force the window background to be the same as the default face background:
-# white.
-
-style "default_background"
-{
- bg[NORMAL] = { 1.0, 1.0, 1.0 }
-}
-
-class "GtkXEmacs" style "default_background"
+++ /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 SXEmacs.
-
-;; SXEmacs 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 3 of the License, or
-;; (at your option) any later version.
-
-;; SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Synched up with: Not in FSF.
-
-;;; Commentary:
-
-;; This file is dumped with SXEmacs (when dialog boxes are compiled in).
-
-(require 'cl)
-(require 'gtk-password-dialog)
-(require 'gtk-file-dialog)
-
-(globally-declare-fboundp
-'(gtk-signal-connect
- gtk-main-quit gtk-window-set-transient-for
- gtk-widget-show-all gtk-main gtk-color-selection-dialog-new
- gtk-color-selection-dialog-ok-button gtk-widget-hide-all
- gtk-color-selection-get-color
- gtk-color-selection-dialog-colorsel
- gtk-color-selection-dialog-cancel-button gtk-widget-show-now
- gtk-widget-grab-focus gtk-widget-destroy gtk-dialog-new
- gtk-window-set-title gtk-container-set-border-width
- gtk-box-set-spacing gtk-dialog-vbox gtk-container-add
- gtk-label-new gtk-button-new-with-label
- gtk-widget-set-sensitive gtk-widget-show gtk-dialog-action-area
- gtk-label-parse-uline gtk-widget-add-accelerator gtk-accel-group-new
- gtk-misc-set-alignment gtk-button-new gtk-window-add-accel-group))
-
-(defun gtk-popup-convert-underscores (str)
- ;; Convert the XEmacs button accelerator representation to Gtk mnemonic
- ;; form. If no accelerator has been provided, put one at the start of the
- ;; string (this mirrors the behaviour under X). This algorithm is also found
- ;; in menubar-gtk.c:convert_underscores().
- (let ((new-str (string))
- (i 0)
- (found-accel nil))
- (while (< i (length str))
- (let ((c (aref str i)))
- (cond ((eq c ?%)
- (setq i (1+ i))
- (if (and (not (eq (aref str i) ?_)) (not (eq (aref str i) ?%)))
- (setq i (1- i)))
- (setq found-accel 1)
- )
- ((eq c ?_)
- (setq new-str (concat new-str "_")))
- ))
- (setq new-str (concat new-str (string (aref str i))))
- (setq i (1+ i))
- )
- (if found-accel new-str (concat "_" new-str))
- ))
-
-(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)
- filename)))
-
-(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)
- (callback nil)
- (flushrightp nil)
- (length nil)
- (label nil)
- (gui-button nil)
- (accel-group (gtk-accel-group-new))
- (accel-key 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))
-
- (setq length (length button))
-
- (cond
- ((= length 1) ; [ "name" ]
- (setq callback nil
- activep nil))
- ((= length 2) ; [ "name" callback ]
- (setq callback (aref button 1)
- activep t))
- ((and (or (= length 3) (= length 4))
- (not (keywordp (aref button 2))))
- ;; [ "name" callback active-p ] or
- ;; [ "name" callback active-p suffix ]
- ;; We ignore the 'suffix' entry, because that is
- ;; what the X code does.
- (setq callback (aref button 1)
- activep (aref button 2)))
- (t ; 100% keyword specification
- (let ((plist (cdr (mapcar 'identity button))))
- (setq activep (plist-get plist :active)
- callback (plist-get plist :callback)))))
-
- ;; Create the label and determine what the mnemonic key is.
- (setq label (gtk-label-new ""))
- (setq accel-key (gtk-label-parse-uline label
- (gtk-popup-convert-underscores (aref button 0))))
- ;; Place the label in the button.
- (gtk-misc-set-alignment label 0.5 0.5)
- (setq gui-button (gtk-button-new))
- (gtk-container-add gui-button label)
- ;; Add ALT-mnemonic to the dialog's accelerator group.
- (gtk-widget-add-accelerator gui-button "clicked" accel-group
- accel-key
- 8 ; GDK_MOD1_MASK
- 4 ; GTK_ACCEL_LOCKED
- )
-
- (push gui-button buttons)
- (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 callback 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)
- ;; Make the dialog listen for global mnemonic keys.
- (gtk-window-add-accel-group dialog accel-group)
-
- (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
- )
- (print
- )
- (page-setup
- )
- (print-setup
- )
- (default
- (error "Unknown type of dialog: %S" type))))
-
-(provide 'dialog-gtk)
+++ /dev/null
-;;; gdk.el --- Import GDK functions into SXEmacs
-
-;; Copyright (C) 2000 Free Software Foundation
-
-;; Maintainer: William Perry <wmperry@gnu.org>
-;; Keywords: extensions, dumped
-
-;; This file is part of SXEmacs.
-
-;; SXEmacs 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 3 of the License, or
-;; (at your option) any later version.
-
-;; SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Synched up with: Not in FSF
-
-;;; Commentary:
-
-;; This file is dumped with SXEmacs.
-
-(eval-and-compile
- (require 'gtk-ffi))
-
-(globally-declare-fboundp
- '(gtk-import-function-internal gtk-call-function))
-
-(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
-;;; glade.el --- Import libglade functions into SXEmacs
-
-;; Copyright (C) 2000 Free Software Foundation
-
-;; Maintainer: William Perry <wmperry@gnu.org>
-;; Keywords: extensions, dumped
-
-;; This file is part of SXEmacs.
-
-;; SXEmacs 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 3 of the License, or
-;; (at your option) any later version.
-
-;; SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Synched up with: Not in FSF
-
-;;; Commentary:
-
-;; This file is dumped with SXEmacs (if glade was detected)
-
-(eval-and-compile
- (require 'gtk-ffi))
-
-(globally-declare-fboundp
- '(gtk-import-function-internal gtk-call-function))
-
-(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 SXEmacs
-
-;; Copyright (C) 2000 Free Software Foundation
-
-;; Maintainer: William Perry <wmperry@gnu.org>
-;; Keywords: extensions, dumped
-
-;; This file is part of SXEmacs.
-
-;; SXEmacs 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 3 of the License, or
-;; (at your option) any later version.
-
-;; SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Synched up with: Not in FSF
-
-;;; Commentary:
-
-;; This file is dumped with SXEmacs.
-
-(eval-and-compile
- (require 'gtk-ffi))
-
-(globally-declare-fboundp
- '(gtk-import-function-internal
- gtk-call-function
- gtk-button-new-with-label))
-
-(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
-(globally-declare-fboundp
- '(gtk-type-from-name
- gtk-import-function-internal
- gtk-call-function))
-
-(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 SXEmacs
-
-;; Copyright (C) 2000 Free Software Foundation
-
-;; Maintainer: William Perry <wmperry@gnu.org>
-;; Keywords: extensions, dumped
-
-;; This file is part of SXEmacs.
-
-;; SXEmacs 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 3 of the License, or
-;; (at your option) any later version.
-
-;; SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; 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))
-
-(globally-declare-fboundp
- '(gtk-import-function-internal gtk-call-function))
-
-;;; 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 SXEmacs.
-
-;; SXEmacs 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 3 of the License, or
-;; (at your option) any later version.
-
-;; SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Synched up with: Not synched.
-
-;;; Commentary:
-
-;; This file is dumped with SXEmacs (when GTK support is compiled in).
-
-(globally-declare-fboundp
- '(gtk-init-pointers
- gtk-font-selection-dialog-new
- gtk-widget-set-sensitive gtk-font-selection-dialog-apply-button
- gtk-signal-connect gtk-main-quit
- gtk-font-selection-dialog-ok-button
- gtk-font-selection-dialog-get-font-name gtk-widget-destroy
- font-menu-set-font font-family font-size
- gtk-font-selection-dialog-cancel-button gtk-widget-show-all
- gtk-main gtk-style-info))
-
-(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
-(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 #r"\(bold\|demibold\|medium\|black\)") ; 1
-; (weight\? "\\(\\*\\|bold\\|demibold\\|medium\\|\\)") ; 1
- (weight\? #r"\([^-]*\)") ; 1
- (slant #r"\([ior]\)") ; 2
-; (slant\? "\\([ior?*]?\\)") ; 2
- (slant\? #r"\([^-]?\)") ; 2
-; (swidth "\\(\\*\\|normal\\|semicondensed\\|\\)") ; 3
- (swidth #r"\([^-]*\)") ; 3
-; (adstyle "\\(\\*\\|sans\\|\\)") ; 4
- (adstyle #r"\([^-]*\)") ; 4
- (pixelsize #r"\(\*\|[0-9]+\)") ; 5
- (pointsize #r"\(\*\|0\|[0-9][0-9]+\)") ; 6
-; (resx "\\(\\*\\|[0-9][0-9]+\\)") ; 7
-; (resy "\\(\\*\\|[0-9][0-9]+\\)") ; 8
- (resx #r"\([*0]\|[0-9][0-9]+\)") ; 7
- (resy #r"\([*0]\|[0-9][0-9]+\)") ; 8
- (spacing "[cmp?*]")
- (avgwidth #r"\(\*\|[0-9]+\)") ; 9
- (registry "[^-]*") ; some fonts have omitted registries
-; (encoding ".+") ; note that encoding may contain "-"...
- (encoding "[^-]+") ; false!
- )
- (setq gtk-font-regexp
- (purecopy
- (concat #r"\`\*?[-?*]"
- 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\?
- #r"\([-*?]\|\'\)")))
- (setq gtk-font-regexp-head-2
- (purecopy
- (concat "\\`[-?*]" foundry - family - weight\? - slant\?
- - swidth - adstyle - pixelsize - pointsize
- #r"\([-*?]\|\'\)")))
- (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 #r"[-?*]\([0-9][0-9]?\)[-?*]"))
- (setq gtk-font-regexp-point (purecopy #r"[-?*]\([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))))
-
-(eval-when-compile (defvar font-menu-this-frame-only-p))
-
-(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))
- (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 SXEmacs.
-
-;; SXEmacs 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 3 of the License, or
-;; (at your option) any later version.
-
-;; SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Synched up with: Not in FSF
-
-;;; Commentary:
-
-;; This file is dumped with SXEmacs.
-
-(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 SXEmacs.
-
-;; SXEmacs 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 3 of the License, or
-;; (at your option) any later version.
-
-;; SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; 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.
-
-(globally-declare-fboundp
- '(gtk-clist-clear
- gtk-clist-freeze gtk-clist-append
- gtk-clist-thaw gtk-combo-set-popdown-strings gtk-dialog-new
- gtk-dialog-vbox gtk-dialog-action-area gtk-window-set-title
- gtk-button-new-with-label gtk-container-add gtk-signal-connect
- gtk-entry-get-text gtk-widget-destroy gtk-combo-new
- gtk-combo-disable-activate gtk-box-pack-start gtk-combo-entry
- gtk-hbox-new gtk-clist-new-with-titles gtk-scrolled-window-new
- gtk-widget-set-usize gtk-clist-get-text gtk-entry-set-text
- gtk-button-clicked gtk-option-menu-new gtk-menu-new
- gtk-label-new gtk-menu-item-new-with-label gtk-menu-append
- gtk-widget-show gtk-option-menu-set-menu gtk-box-pack-end
- gtk-entry-new gtk-widget-set-sensitive gtk-widget-realize))
-
-(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 SXEmacs.
-
-;; SXEmacs 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 3 of the License, or
-;; (at your option) any later version.
-
-;; SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>.
-;;; 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)
-
-(globally-declare-boundp
- '(gtk-font-regexp
- gtk-font-regexp-foundry-and-family
- gtk-font-regexp-spacing))
-
-(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.
- #r"\`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 SXEmacs.
-
-;; SXEmacs 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 3 of the License, or
-;; (at your option) any later version.
-
-;; SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; 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 SXEmacs.
-
-;;; Code:
-
-(progn
- (if (featurep 'gtk)
- (set-console-type-image-conversion-list
- 'gtk
- `(,@(if (featurep 'xpm) '((#r"\.xpm\'" [xpm :file nil] 2)))
- (#r"\.xbm\'" [xbm :file nil] 2)
- ,@(if (featurep 'xpm) '((#r"\`/\* XPM \*/" [xpm :data nil] 2)))
- ,@(if (featurep 'xface) '(("\\`X-Face:" [xface :data nil] 2)))
- ,@(if (featurep 'gif) '((#r"\.gif\'" [gif :file nil] 2)
- ("\\`GIF8[79]" [gif :data nil] 2)))
- ,@(if (featurep 'jpeg) '((#r"\.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) '((#r"\.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 sxemacs-logo
- (concat "../etc/"
- (if emacs-beta-version
- "sxemacs-beta.xpm"
- "sxemacs.xpm"))
- 'global 'gtk))
- (t
- (set-glyph-image sxemacs-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 gtk
-;; 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 SXEmacs.
-
-;; SXEmacs 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 3 of the License, or
-;; (at your option) any later version.
-
-;; SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-(globally-declare-boundp
- '(gtk-initial-argv-list
- gtk-initial-geometry))
-
-(globally-declare-fboundp
- '(gtk-keysym-on-keyboard-p))
-
-(defvar gtk-win-initted nil)
-(defvar gtk-pre-win-initted nil)
-(defvar gtk-post-win-initted nil)
-
-(defvar gtk-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: SXEmacs Development Team
-;; Keywords: mouse, dumped
-
-;; This file is part of SXEmacs.
-
-;; SXEmacs 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 3 of the License, or
-;; (at your option) any later version.
-
-;; SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Synched up with: Not synched.
-
-;;; Commentary:
-
-;; This file is dumped with SXEmacs (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
-
-(globally-declare-fboundp
- '(gtk-window-new
- gtk-hbox-new gtk-container-add gtk-widget-show-all))
-
-(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 SXEmacs.
-
-;; SXEmacs 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 3 of the License, or
-;; (at your option) any later version.
-
-;; SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Synched up with: Not in FSF.
-
-(globally-declare-fboundp
- '(gtk-dialog-new
- gtk-dialog-vbox gtk-dialog-action-area
- gtk-window-set-title gtk-button-new-with-label
- gtk-container-add gtk-signal-connect gtk-entry-get-text
- gtk-widget-destroy gtk-container-set-border-width gtk-label-new
- gtk-misc-set-alignment gtk-entry-new gtk-widget-set-sensitive
- gtk-entry-set-text gtk-entry-select-region))
-
-(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 SXEmacs.
-
-;; SXEmacs 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 3 of the License, or
-;; (at your option) any later version.
-
-;; SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Synched up with: Not in FSF
-
-;;; Commentary:
-
-;; This file is dumped with SXEmacs (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
-(globally-declare-fboundp
- '(gtk-fundamental-type))
-
-(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"
- (declare (special c-mode-common-hook c-mode-hook))
- (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 SXEmacs
-
-;; Copyright (C) 2000 Free Software Foundation
-
-;; Maintainer: William Perry <wmperry@gnu.org>
-;; Keywords: extensions, dumped
-
-;; This file is part of SXEmacs.
-
-;; SXEmacs 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 3 of the License, or
-;; (at your option) any later version.
-
-;; SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Synched up with: Not in FSF
-
-;;; Commentary:
-
-;; This file is dumped with SXEmacs.
-
-(eval-and-compile
- (require 'gtk-ffi))
-
-(globally-declare-fboundp
- '(gtk-import-function-internal
- gtk-call-function gtk-import-variable-internal gtk-ctree-recurse))
-
-(gtk-import-function GtkAccelGroup gtk_accel_group_new)
-
-(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
-(globally-declare-fboundp
- '(gtk-import-function-internal gtk-call-function gtk-type-name))
-
-(globally-declare-boundp
- '(gtk-enumeration-info))
-
-(eval-when-compile (require 'gtk-ffi))
-
-(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 SXEmacs 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 SXEmacs.
-
-;; SXEmacs 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 3 of the License, or
-;; (at your option) any later version.
-
-;; SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Synched up with: Not in FSF.
-
-;;; Commentary:
-
-;; This file is dumped with SXEmacs (when embedded widgets are compiled in).
-
-(globally-declare-fboundp
- '(gtk-button-new-with-label
- gtk-signal-connect
- gtk-radio-button-new-with-label gtk-radio-button-group
- gtk-toggle-button-set-active gtk-check-button-new-with-label
- gtk-widget-show-all gtk-notebook-new gtk-notebook-append-page
- gtk-vbox-new gtk-label-new gtk-adjustment-new
- gtk-progress-bar-new-with-adjustment gtk-adjustment-set-value
- gtk-entry-new gtk-entry-set-text gtk-widget-set-style
- gtk-widget-get-style))
-
-(defvar foo)
-
-(defun gtk-widget-get-callback (widget plist instance)
- (let ((cb (plist-get plist :callback))
- (ex (plist-get plist :callback-ex))
- (real-cb nil))
- (cond
- (ex
- (gtk-signal-connect widget 'button-release-event
- (lambda (widget event data)
- (put widget 'last-event event)))
- `(lambda (widget &rest ignored)
- (funcall ,ex ,instance (get widget 'last-event))))
- (cb
- `(lambda (widget &rest ignored)
- (if (functionp ,real-cb)
- (funcall ,real-cb)
- (eval ,real-cb))))
- (t
- nil))))
-
-(defun gtk-widget-instantiate-button-internal (plist instance)
- (let* ((type (or (plist-get plist :style) 'button))
- (label (or (plist-get plist :descriptor) (symbol-name type)))
- (widget nil))
- (case type
- (button
- (setq widget (gtk-button-new-with-label label))
- (gtk-signal-connect widget 'clicked
- (gtk-widget-get-callback widget plist instance)))
- (radio
- (let ((aux nil)
- (selected-p (plist-get plist :selected)))
- (setq widget (gtk-radio-button-new-with-label nil label)
- aux (gtk-radio-button-new-with-label
- (gtk-radio-button-group widget)
- "bogus sibling"))
- (gtk-toggle-button-set-active widget (eval selected-p))
- (gtk-signal-connect widget 'toggled
- (gtk-widget-get-callback widget plist instance) aux)))
- (otherwise
- ;; Check boxes
- (setq widget (gtk-check-button-new-with-label label))
- (gtk-toggle-button-set-active widget
- (eval (plist-get plist :selected)))
- (gtk-signal-connect widget 'toggled
- (gtk-widget-get-callback widget plist instance))))
- (gtk-widget-show-all widget)
- widget))
-
-(defun gtk-widget-instantiate-notebook-internal (plist 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 instance)))
-; (add-timeout 0.1 (lambda (obj)
-; (gtk-widget-set-style obj
-; (gtk-widget-get-style
-; (frame-property nil 'text-widget))))
-; widget)
- widget))
-
-(defun gtk-widget-property-internal ()
- nil)
-
-(defun gtk-widget-redisplay-internal ()
- nil)
-
-(provide 'widgets-gtk)
+++ /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
-/* glade.c
-**
-** Description: Interface to `libglade' for SXEmacs/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
-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
-## SXEmacs - Ent Makefile.am
-
-## Copyright (C) 2010 Steve Youngs
-
-## This file is part of SXEmacs.
-
-## SXEmacs 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 3 of the License, or
-## (at your option) any later version.
-
-## SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-## Process this file with automake to produce Makefile.in
-
-# Help the Developers and yourself. Just use the C locale and settings
-# for the compilation. They can still be overriden by make LANG=<whatever>
-# but that is general a not very good idea
-LANG=C
-LC_ALL=C
-
-builddir = @builddir@
-srcdir = @srcdir@
-top_builddir = @top_builddir@
-top_build_prefix = $(top_builddir)/
-top_srcdir = @top_srcdir@
-abs_builddir = @abs_builddir@
-abs_top_builddir = @abs_top_builddir@
-abs_top_srcdir = @abs_top_srcdir@
-sxelibsrcdir = $(abs_top_srcdir)/lib-src
-
-AM_CFLAGS = -Demacs $(OPENSSL_CFLAGS) -DUSE_SXEMACS_CONFIG_H -DXTSTRINGDEFINES
-AM_CPPFLAGS = -I$(srcdir) -I$(builddir) -I$(top_srcdir)/src -I$(top_builddir)/src -I$(top_builddir) $(c_switch_general) $(LTDLINCL)
-
-headerdir = $(includedir)/$(instvarsepdir)
-archlibdir = ${libdir}/${instvardir}/${configuration}
-
-
-ETAGS = $(top_builddir)/lib-src/etags
-TAGS_DEPENDENCIES = $(ETAGS)
-
-all_sources=
-noinst_LIBRARIES=
-header_HEADERS=$(acgen_headers)
-
-libsxeuiGTK_a_headers = \
- glyphs-gtk.h console-gtk.h gccache-gtk.h gtk-xemacs.h \
- gui-gtk.h objects-gtk.h scrollbar-gtk.h ui-gtk.h
-libsxeuiGTK_a_sources = \
- console-gtk.c device-gtk.c event-gtk.c frame-gtk.c \
- objects-gtk.c redisplay-gtk.c glyphs-gtk.c select-gtk.c \
- gccache-gtk.c gtk-xemacs.c ui-gtk.c \
- menubar-gtk.c scrollbar-gtk.c dialog-gtk.c toolbar-gtk.c \
- gui-gtk.c ui-byhand.c
-libsxeuiGtk_a_SOURCES = $(libsxeuiGtk_a_headers) $(libsxeuiGTK_a_sources)
-libsxeuiGtk_a_CPPFLAGS = $(AM_CPPFLAGS) $(c_switch_general) $(X_CFLAGS)
-libsxeuiGtk_a_LIBADD=$(libsxeuiGtk_objs)
-libsxeuiGtk_a_DEPENDENCIES = $(libsxeuiGtk_a_LIBADD)
-all_sources += $(libsxeuiGtk_objs:.o=.c)
-
-noinst_LIBRARIES += libsxeuiGtk.a
-
-#
-# Help the SXEmacs developers get nice post-processed source files
-
-## Create preprocessor output (debugging purposes only)
-.c.i:
- $(COMPILE) -E -o $@ $<
-
-## Create assembler output (debugging purposes only)
-.c.s:
- $(COMPILE) -S -c $(cflags) $<
+++ /dev/null
-/* Console functions for X windows.
- Copyright (C) 1996 Ben Wing.
-
-This file is part of SXEmacs
-
-SXEmacs 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 3 of the License, or
-(at your option) any later version.
-
-SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>. */
-
-
-/* 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 "ui/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 SXEmacs
-
-SXEmacs 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 3 of the License, or
-(at your option) any later version.
-
-SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>. */
-
-
-/* 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 "ui/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;
-
- /* Data for widget callbacks. It is impossible to pass all the necessary
- data through the GTK signal API so instead it is registered here and the
- hash key is passed instead. */
- Lisp_Object widget_instance_hash_table;
- Lisp_Object widget_callback_hash_table;
- Lisp_Object widget_callback_ex_hash_table;
-};
-
-#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)
-#define FRAME_GTK_WIDGET_INSTANCE_HASH_TABLE(f) (FRAME_GTK_DATA (f)->widget_instance_hash_table)
-#define FRAME_GTK_WIDGET_CALLBACK_HASH_TABLE(f) (FRAME_GTK_DATA (f)->widget_callback_hash_table)
-#define FRAME_GTK_WIDGET_CALLBACK_EX_HASH_TABLE(f) (FRAME_GTK_DATA (f)->widget_callback_ex_hash_table)
-
-/* Special data used to quickly identify the frame that contains a widget. */
-#define GTK_DATA_FRAME_IDENTIFIER "xemacs::frame"
-
-/* The hashcode in the frame hash table of a tab_control tab's callback data. */
-#define GTK_DATA_TAB_HASHCODE_IDENTIFIER "xemacs::tab_hashcode"
-
-#define GTK_DATA_GUI_IDENTIFIER "xemacs::gui_id"
-
-/* 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_widget_to_frame(GtkWidget *);
-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 SXEmacs
-
-SXEmacs 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 3 of the License, or
-(at your option) any later version.
-
-SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>. */
-
-
-/* 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/events.h"
-#include "ui/faces.h"
-#include "ui/frame.h"
-#include "ui/redisplay.h"
-#include "sysdep.h"
-#include "ui/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_clear_event_handle(GtkWidget * widget,
- GdkEventSelection * event,
- 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("SXEmacs", 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++) {
- xfree(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_selection_add_target(GTK_WIDGET(app_shell),
- gdk_atom_intern("CLIPBOARD", FALSE),
- 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_clear_event",
- GTK_SIGNAL_FUNC
- (emacs_gtk_selection_clear_event_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 SXEmacs.
-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);
-}
-\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_IMPLEMENTATION_FLAGS (gtk, XDEVIMPF_PIXEL_GEOMETRY); */
- /* I inserted the above commented out statement, as the original
- implementation of gtk_device_implementation_flags(), which I
- deleted, contained commented out XDEVIMPF_PIXEL_GEOMETRY - kkm */
-}
-
-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 SXEmacs
-
-SXEmacs 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 3 of the License, or
-(at your option) any later version.
-
-SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>. */
-
-
-/* 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/events.h"
-#include "ui/frame.h"
-#include "ui/gui.h"
-#include "opaque.h"
-#include "ui/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
-/* 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 SXEmacs
-
-SXEmacs 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 3 of the License, or
-(at your option) any later version.
-
-SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>. */
-
-
-/* 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 "mem/blocktype.h"
-#include "buffer.h"
-#include "commands.h"
-#include "ui/console.h"
-#include "ui/TTY/console-tty.h"
-#include "events/events.h"
-#include "ui/frame.h"
-#include "objects-gtk.h"
-#include "process.h"
-#include "ui/redisplay.h"
-#include "elhash.h"
-
-#include "gtk-xemacs.h"
-
-#include "systime.h"
-#include "sysproc.h" /* for MAXDESC */
-
-#ifdef FILE_CODING
-#include "lstream.h"
-#include "mule/file-coding.h"
-#endif
-
-#include <gdk/gdkkeysyms.h>
-
-#ifdef HAVE_DRAGNDROP
-#include "dragdrop.h"
-#endif
-
-#ifdef HAVE_MENUBARS
-# include "ui/menubar.h"
-#endif
-
-#if defined (HAVE_OFFIX_DND)
-#include "X11/offix.h"
-#endif
-
-#include "events/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;
-
-void enqueue_gtk_dispatch_event(Lisp_Object event);
-
-/*
- * Identify if the keysym is a modifier. This implementation mirrors x.org's
- * IsModifierKey(), but for GDK keysyms.
- */
-#ifdef GDK_ISO_Lock
-#define IS_MODIFIER_KEY(keysym) \
- ((((keysym) >= GDK_Shift_L) && ((keysym) <= GDK_Hyper_R)) \
- || (((keysym) >= GDK_ISO_Lock) && \
- ((keysym) <= GDK_ISO_Last_Group_Lock)) \
- || ((keysym) == GDK_Mode_switch) \
- || ((keysym) == GDK_Num_Lock))
-#else
-#define IS_MODIFIER_KEY(keysym) \
- ((((keysym) >= GDK_Shift_L) && ((keysym) <= GDK_Hyper_R)) \
- || ((keysym) == GDK_Mode_switch) \
- || ((keysym) == GDK_Num_Lock))
-#endif
-
-\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
- SXEmacs 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];
- int sz = snprintf(buf, sizeof(buf),
- "unknown-keysym-0x%X",
- (int)keysym);
- assert(sz >= 0 && sz < sizeof(buf));
- 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 'sxemacs -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;
-
-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) {
- /* SXEmacs 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 SXEmacs 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;
-
- {
- int numero_de_botao = -1;
-
- if (!key_event_p)
- numero_de_botao =
- gdk_event->button.button;
-
- /* the button gets noted either in the button or the modifiers
- field, but not both. */
- if (numero_de_botao != 1
- && (*state & GDK_BUTTON1_MASK))
- modifiers |= XEMACS_MOD_BUTTON1;
- if (numero_de_botao != 2
- && (*state & GDK_BUTTON2_MASK))
- modifiers |= XEMACS_MOD_BUTTON2;
- if (numero_de_botao != 3
- && (*state & GDK_BUTTON3_MASK))
- modifiers |= XEMACS_MOD_BUTTON3;
- if (numero_de_botao != 4
- && (*state & GDK_BUTTON4_MASK))
- modifiers |= XEMACS_MOD_BUTTON4;
- if (numero_de_botao != 5
- && (*state & GDK_BUTTON5_MASK))
- modifiers |= XEMACS_MOD_BUTTON5;
- }
-
- /* 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;
-
-#ifdef HAVE_MENUBARS
- /* If the user wants see if the event is a menu bar accelerator.
- The process of checking absorbs the event and starts menu
- processing so send a null event into XEmacs to make sure it
- does nothing.
- */
- if (!NILP(Vmenu_accelerator_enabled)
- &&
- gtk_accel_groups_activate(GTK_OBJECT
- (FRAME_GTK_SHELL_WIDGET
- (frame)),
- key_event->keyval,
- *state)) {
- zero_event(emacs_event);
- return 1;
- }
-#endif
-
- /* 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;
- if (mask & GDK_BUTTON1_MASK)
- modifiers |= XEMACS_MOD_BUTTON1;
- if (mask & GDK_BUTTON2_MASK)
- modifiers |= XEMACS_MOD_BUTTON2;
- if (mask & GDK_BUTTON3_MASK)
- modifiers |= XEMACS_MOD_BUTTON3;
- if (mask & GDK_BUTTON4_MASK)
- modifiers |= XEMACS_MOD_BUTTON4;
- if (mask & GDK_BUTTON5_MASK)
- modifiers |= XEMACS_MOD_BUTTON5;
-
- /* 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-SXEmacs 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;
- staticpro(&dispatch_event_queue_tail);
-
- 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,
- "SXEmacs: %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 SXEmacs
-
-SXEmacs 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 3 of the License, or
-(at your option) any later version.
-
-SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>. */
-
-
-/* Synched up with: Not synched with FSF. */
-
-/* Substantially rewritten for SXEmacs. */
-/* Revamped to use Gdk/Gtk by William Perry */
-
-#include <config.h>
-#include "lisp.h"
-
-#include "elhash.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/events.h"
-#include "extents.h"
-#include "ui/faces.h"
-#include "ui/frame.h"
-#include "ui/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 "sxemacs::transient_for"
-#define UNMAPPED_DATA_IDENTIFIER "sxemacs::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 which contains the given widget. */
-struct frame *gtk_widget_to_frame(GtkWidget * w)
-{
- struct frame *f = NULL;
-
- for (; w; w = w->parent) {
- if ((f = (struct frame *)gtk_object_get_data(GTK_OBJECT(w),
- GTK_DATA_FRAME_IDENTIFIER)))
- return (f);
- }
-
- return (selected_frame());
-}
-
-/* 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("SXEmacs", "SXEmacs/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), GTK_DATA_FRAME_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 */
-
-#ifdef HAVE_GNOME
- if (GNOME_IS_APP(shell))
- gnome_app_set_contents(GNOME_APP(shell), text);
- else
-#endif
- /* 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, "SXEmacs::shell");
- gtk_widget_set_name(container, "SXEmacs::container");
- gtk_widget_set_name(text, "SXEmacs::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;
-
- /*
- Hashtables of callback data for glyphs on the frame. Make them EQ because
- we only use ints as keys. Otherwise we run into stickiness in redisplay
- because internal_equal() can QUIT. See enter_redisplay_critical_section().
- */
- FRAME_GTK_WIDGET_INSTANCE_HASH_TABLE(f) =
- make_lisp_hash_table(50, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQ);
- FRAME_GTK_WIDGET_CALLBACK_HASH_TABLE(f) =
- make_lisp_hash_table(50, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQ);
- FRAME_GTK_WIDGET_CALLBACK_EX_HASH_TABLE(f) =
- make_lisp_hash_table(50, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQ);
-}
-\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]);
- mark_object(FRAME_GTK_WIDGET_INSTANCE_HASH_TABLE(f));
- mark_object(FRAME_GTK_WIDGET_CALLBACK_HASH_TABLE(f));
- mark_object(FRAME_GTK_WIDGET_CALLBACK_EX_HASH_TABLE(f));
-}
-
-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? */
- int sz = snprintf(str, sizeof(str), "%lu",
- GDK_WINDOW_XWINDOW(GET_GTK_WIDGET_WINDOW
- (FRAME_GTK_TEXT_WIDGET(f))));
- assert(sz >= 0 && sz < sizeof(str));
- 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_map(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_unmap(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 SXEmacs
-
-SXEmacs 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 3 of the License, or
-(at your option) any later version.
-
-SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>. */
-
-
-/* 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 SXEmacs
-
-SXEmacs 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 3 of the License, or
-(at your option) any later version.
-
-SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>. */
-
-
-/* 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
-/* 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 SXEmacs
-
-SXEmacs 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 3 of the License, or
-(at your option) any later version.
-
-SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>. */
-
-
-/* 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 "ui/glyphs.h"
-#include "glyphs-gtk.h"
-#include "objects-gtk.h"
-#include "gui-gtk.h"
-#include "ui-gtk.h"
-
-#include "buffer.h"
-#include "ui/window.h"
-#include "ui/frame.h"
-#include "ui/insdel.h"
-#include "opaque.h"
-#include "ui/faces.h"
-#include "elhash.h"
-#include "events/events.h"
-
-#include "ui/imgproc.h"
-
-#include "sysfile.h"
-
-#include <setjmp.h>
-
-#if defined (HAVE_XPM)
-#include <X11/xpm.h>
-#endif
-
-#ifdef FILE_CODING
-#include "mule/file-coding.h"
-#endif
-
-extern void enqueue_gtk_dispatch_event(Lisp_Object event);
-
-/* Widget callback hash table callback slot. */
-#define WIDGET_GLYPH_SLOT 0
-
-#if SXE_INTBITS == 32
-# define FOUR_BYTE_TYPE unsigned int
-#elif SXE_LONGBITS == 32
-# define FOUR_BYTE_TYPE unsigned long
-#elif SXE_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
-
-#if 1
-DECLARE_IMAGE_INSTANTIATOR_FORMAT(rawrgb);
-DECLARE_IMAGE_INSTANTIATOR_FORMAT(rawrgba);
-#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 "ui/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_ATOMIC(*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:
- write_fmt_str(printcharfun, " (0x%lx",
- (unsigned long)IMAGE_INSTANCE_GTK_PIXMAP(p));
- if (IMAGE_INSTANCE_GTK_MASK(p)) {
- write_fmt_str(printcharfun, "/0x%lx",
- (unsigned long)IMAGE_INSTANCE_GTK_MASK(p));
- }
- 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 *
- **********************************************************************/
-
-/* strcasecmp() is not sufficiently portable or standard,
- and it's easier just to write our own. */
-static int ascii_strcasecmp(const char *s1, const char *s2)
-{
- while (1) {
- char c1 = *s1++;
- char c2 = *s2++;
- if (c1 >= 'A' && c1 <= 'Z')
- c1 += 'a' - 'A';
- if (c2 >= 'A' && c2 <= 'Z')
- c2 += 'a' - 'A';
- if (c1 != c2)
- return c1 - c2;
- if (c1 == '\0')
- return 0;
- }
-}
-
-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;
- 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;
- const unsigned char *volatile dstring;
-
- 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));
-
- /* Extract all the entries from xpm-color-symbols */
- color_symbols =
- extract_xpm_color_names(device, domain, color_symbol_alist,
- &nsymbols);
-
- assert(!NILP(data));
-
- LISP_STRING_TO_EXTERNAL(data, dstring, Qbinary);
-
- /*
- * GTK only uses the 'c' color entry of an XPM and doesn't use the symbolic
- * color names at all. This is unfortunate because the way to change the
- * colors from lisp is by adding the symbolic names, and the new colors, to
- * the variable xpm-color-symbols.
- *
- * To get around this decode the XPM, add a 'c' entry of the desired color
- * for each matching symbolic color, recode the XPM and pass it to GTK. The
- * decode and recode stages aren't too bad because this also performs the
- * external to internal format translation, which avoids contortions like
- * writing the XPM back to disk in order to get it processed.
- */
-
- {
- XpmImage image;
- XpmInfo info;
- char **data;
-
- XpmCreateXpmImageFromBuffer((char *)dstring, &image, &info);
-
- for (i = 0; i < nsymbols; i++) {
- unsigned j;
-
- for (j = 0; j < image.ncolors; j++) {
- if (image.colorTable[j].symbolic != NULL &&
- !ascii_strcasecmp(color_symbols[i].name,
- image.colorTable[j].
- symbolic)) {
- int maxLen = 16, sz;
- image.colorTable[j].c_color =
- xmalloc(maxLen);
-
- sz = snprintf(image.colorTable[j].c_color,
- maxLen, "#%.4x%.4x%.4x",
- color_symbols[i].color.red,
- color_symbols[i].color.green,
- color_symbols[i].color.blue);
- assert( sz >= 0 && sz < maxLen);
- }
- }
- }
-
- XpmCreateDataFromXpmImage(&data, &image, &info);
-
- pixmap = gdk_pixmap_create_from_xpm_d(window, &mask, NULL,
- data);
- }
-
- 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_PIXMAP_MASK(ii) = (void *)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 0
- 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);
-#endif
-
- /* 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;
- int moving;
-
- 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;
-
- /* Is the widget cganging position? */
- moving = (a.x != wid->allocation.x) ||
- (a.y != wid->allocation.y);
-
- if ((a.width != wid->allocation.width) ||
- (a.height != wid->allocation.height) || moving) {
- gtk_widget_size_allocate(IMAGE_INSTANCE_GTK_CLIPWIDGET
- (p), &a);
- }
-
- if (moving) {
- guint32 old_flags =
- GTK_WIDGET_FLAGS(FRAME_GTK_TEXT_WIDGET(f));
-
- /* 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,
- a.x, a.y);
- } else {
- IMAGE_INSTANCE_GTK_ALREADY_PUT(p) = TRUE;
- gtk_fixed_put(GTK_FIXED
- (FRAME_GTK_TEXT_WIDGET(f)), wid,
- a.x, a.y);
- }
-
- GTK_WIDGET_FLAGS(FRAME_GTK_TEXT_WIDGET(f)) = old_flags;
- } else {
- if (IMAGE_INSTANCE_GTK_ALREADY_PUT(p)) {
- /* Do nothing... */
- } else {
- /* Must make sure we have put the image at least once! */
- IMAGE_INSTANCE_GTK_ALREADY_PUT(p) = TRUE;
- gtk_fixed_put(GTK_FIXED
- (FRAME_GTK_TEXT_WIDGET(f)), wid,
- a.x, a.y);
- }
- }
-
- 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)) {
- GtkRequisition r;
- GtkAllocation a = IMAGE_INSTANCE_GTK_CLIPWIDGET(p)->allocation;
-
- assert(IMAGE_INSTANCE_GTK_WIDGET_ID(p) &&
- IMAGE_INSTANCE_GTK_CLIPWIDGET(p));
-
- a.width = r.width = IMAGE_INSTANCE_WIDTH(p);
- a.height = r.height = IMAGE_INSTANCE_HEIGHT(p);
-
- /* Force the widget's preferred and actual size to what we say it shall
- be. */
- gtk_widget_size_request(IMAGE_INSTANCE_GTK_CLIPWIDGET(p), &r);
- gtk_widget_size_allocate(IMAGE_INSTANCE_GTK_CLIPWIDGET(p), &a);
- }
-
- /* 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;
-
- /* The current theme may produce a widget of a different size that what we
- expect so force reconsideration of the widget's size. */
- IMAGE_INSTANCE_LAYOUT_CHANGED(ii) = 1;
-
- 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(label);
-/* Note: tab_control has a custom instantiator (see below) */
-
-/*
- Ask the widget to return it's preferred size. This device method must
- defined for all widgets that also have format specific version of
- query_geometry defined in glyphs-widget.c. This is because those format
- specific versions return sizes that are appropriate for the X widgets. For
- GTK, the size of a widget can change at runtime due to the user changing
- their theme.
-
- This method can be called before the widget is instantiated. This is
- because instantiate_image_instantiator() is tying to be helpful to other
- toolkits and supply sane geometry values to them. This is not appropriate
- for GTK and can be ignored.
-
- This method can be used by all widgets.
-*/
-static void
-gtk_widget_query_geometry(Lisp_Object image_instance,
- int *width, int *height,
- enum image_instance_geometry disp, Lisp_Object domain)
-{
- Lisp_Image_Instance *p = XIMAGE_INSTANCE(image_instance);
-
- if (p->data != NULL) {
- GtkWidget *w = IMAGE_INSTANCE_GTK_CLIPWIDGET(p);
- GtkRequisition r;
-
- gtk_widget_size_request(w, &r);
- *height = r.height;
- *width = r.width;
- }
-}
-\f
-/* Button functions. */
-
-/* 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;
-}
-\f
-/* Progress gauge functions. */
-
-/* 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);
- }
-}
-\f
-/* Tab Control functions. */
-
-/*
- Register a widget's callbacks with the frame's hashtable. The hashtable is
- weak so deregistration is handled automatically. Tab controls have per-tab
- callback list functions and the GTK callback architecture is not
- sufficiently flexible to deal with this. Instead, the functions are
- registered here and the id is passed through the callback loop.
- */
-static int
-gtk_register_gui_item(Lisp_Object image_instance, Lisp_Object gui,
- Lisp_Object domain)
-{
- struct frame *f = XFRAME(DOMAIN_FRAME(domain));
- int id = gui_item_id_hash(FRAME_GTK_WIDGET_CALLBACK_HASH_TABLE(f),
- gui, WIDGET_GLYPH_SLOT);
-
- Fputhash(make_int(id), image_instance,
- FRAME_GTK_WIDGET_INSTANCE_HASH_TABLE(f));
- Fputhash(make_int(id), XGUI_ITEM(gui)->callback,
- FRAME_GTK_WIDGET_CALLBACK_HASH_TABLE(f));
- Fputhash(make_int(id), XGUI_ITEM(gui)->callback_ex,
- FRAME_GTK_WIDGET_CALLBACK_EX_HASH_TABLE(f));
- return id;
-}
-
-/*
- Append the given item as a tab to the notebook. Callbacks, etc are all
- setup.
- */
-static void
-gtk_add_tab_item(Lisp_Object image_instance,
- GtkNotebook * nb, Lisp_Object item, Lisp_Object domain, int i)
-{
- Lisp_Object name;
- int hash_id = 0;
- char *c_name = NULL;
- GtkWidget *box;
-
- if (GUI_ITEMP(item)) {
- Lisp_Gui_Item *pgui = XGUI_ITEM(item);
-
- if (!STRINGP(pgui->name))
- pgui->name = Feval(pgui->name);
-
- CHECK_STRING(pgui->name);
-
- hash_id = gtk_register_gui_item(image_instance, item, domain);
- name = pgui->name;
- } else {
- CHECK_STRING(item);
- name = item;
- }
-
- TO_EXTERNAL_FORMAT(LISP_STRING, name, C_STRING_ALLOCA, c_name, Qctext);
-
- /* Dummy widget that the notbook wants to display when a tab is selected. */
- box = gtk_vbox_new(FALSE, 3);
-
- /*
- Store the per-tab callback data id in the tab. The callback functions
- themselves could have been stored in the widget but this avoids having to
- worry about the garbage collector running between here and the callback
- function.
- */
- gtk_object_set_data(GTK_OBJECT(box), GTK_DATA_TAB_HASHCODE_IDENTIFIER,
- (gpointer) hash_id);
-
- gtk_notebook_append_page(nb, box, gtk_label_new(c_name));
-}
-
-/* Signal handler for the switch-page signal. */
-static void gtk_tab_control_callback(GtkNotebook * notebook,
- GtkNotebookPage * page,
- gint page_num, gpointer user_data)
-{
- /*
- This callback is called for every selection, not just user selection.
- We're only interested in user selection, which occurs outside of
- redisplay.
- */
-
- if (!in_display) {
- Lisp_Object image_instance, callback, callback_ex;
- Lisp_Object frame, event;
- int update_subwindows_p = 0;
- struct frame *f = gtk_widget_to_frame(GTK_WIDGET(notebook));
- int id;
-
- if (!f)
- return;
- frame = wrap_frame(f);
-
- id = (int)gtk_object_get_data(GTK_OBJECT(page->child),
- GTK_DATA_TAB_HASHCODE_IDENTIFIER);
- image_instance = Fgethash(make_int(id),
- FRAME_GTK_WIDGET_INSTANCE_HASH_TABLE
- (f), Qnil);
- callback =
- Fgethash(make_int(id),
- FRAME_GTK_WIDGET_CALLBACK_HASH_TABLE(f), Qnil);
- callback_ex =
- Fgethash(make_int(id),
- FRAME_GTK_WIDGET_CALLBACK_EX_HASH_TABLE(f), Qnil);
- update_subwindows_p = 1;
-
- /* It is possible for a widget action to cause it to get out of
- sync with its instantiator. Thus it is necessary to signal
- this possibility. */
- if (IMAGE_INSTANCEP(image_instance))
- XIMAGE_INSTANCE_WIDGET_ACTION_OCCURRED(image_instance) =
- 1;
-
- if (!NILP(callback_ex) && !UNBOUNDP(callback_ex)) {
- event = Fmake_event(Qnil, Qnil);
-
- XEVENT(event)->event_type = misc_user_event;
- XEVENT(event)->channel = frame;
- XEVENT(event)->event.eval.function = Qeval;
- XEVENT(event)->event.eval.object =
- list4(Qfuncall, callback_ex, image_instance, event);
- } else if (NILP(callback) || UNBOUNDP(callback))
- event = Qnil;
- else {
- Lisp_Object fn, arg;
-
- event = Fmake_event(Qnil, Qnil);
-
- get_gui_callback(callback, &fn, &arg);
- XEVENT(event)->event_type = misc_user_event;
- XEVENT(event)->channel = frame;
- XEVENT(event)->event.eval.function = fn;
- XEVENT(event)->event.eval.object = arg;
- }
-
- if (!NILP(event))
- enqueue_gtk_dispatch_event(event);
-
- /* The result of this evaluation could cause other instances to change so
- enqueue an update callback to check this. */
- if (update_subwindows_p && !NILP(event))
- enqueue_magic_eval_event(update_widget_instances,
- frame);
- }
-}
-
-/* Create a tab_control widget. The special handling of the individual tabs
- means that the normal instantiation code cannot be used. */
-static void
-gtk_tab_control_instantiate(Lisp_Object image_instance,
- Lisp_Object instantiator,
- Lisp_Object pointer_fg,
- Lisp_Object pointer_bg,
- int dest_mask, Lisp_Object domain)
-{
- Lisp_Object rest;
- Lisp_Image_Instance *ii = XIMAGE_INSTANCE(image_instance);
- int i = 0;
- int selected = 0;
- GtkNotebook *nb;
-
- /* The normal instantiation is still needed. */
- gtk_widget_instantiate(image_instance, instantiator, pointer_fg,
- pointer_bg, dest_mask, domain);
-
- nb = GTK_NOTEBOOK(IMAGE_INSTANCE_GTK_CLIPWIDGET(ii));
-
- /* Add items to the tab, find the current selection */
- LIST_LOOP(rest, XCDR(IMAGE_INSTANCE_WIDGET_ITEMS(ii))) {
- gtk_add_tab_item(image_instance, nb, XCAR(rest), domain, i);
-
- if (gui_item_selected_p(XCAR(rest)))
- selected = i;
-
- i++;
- }
-
- gtk_notebook_set_page(nb, selected);
-
- /* Call per-tab lisp callback when a tab is pressed. */
- gtk_signal_connect(GTK_OBJECT(nb), "switch-page",
- GTK_SIGNAL_FUNC(gtk_tab_control_callback), NULL);
-}
-
-/* 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)) {
- int i = 0;
- 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)));
-
- /* 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;
-
- gtk_notebook_set_page(GTK_NOTEBOOK
- (IMAGE_INSTANCE_GTK_CLIPWIDGET
- (ii)), i);
-
- break;
- }
-
- i++;
- }
- } 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;
- int i;
-
- /* Why is there no API to remove everything from a notebook? */
- if (num_pages >= 0) {
- for (i = num_pages; i >= 0; --i) {
- gtk_notebook_remove_page(nb, i);
- }
- }
-
- i = 0;
-
- LIST_LOOP(rest,
- XCDR(IMAGE_INSTANCE_WIDGET_PENDING_ITEMS(ii)))
- {
- gtk_add_tab_item(image_instance, nb, XCAR(rest),
- IMAGE_INSTANCE_FRAME(ii), i);
- }
-
- /* 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
-#if 1
- IIFORMAT_VALID_CONSOLE(gtk, rawrgb);
- IIFORMAT_VALID_CONSOLE(gtk, rawrgba);
-#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);
- IIFORMAT_HAS_SHARED_DEVMETHOD(gtk, button, query_geometry, widget);
- /* general widget methods. */
- INITIALIZE_DEVICE_IIFORMAT(gtk, widget);
- IIFORMAT_HAS_DEVMETHOD(gtk, widget, property);
- IIFORMAT_HAS_DEVMETHOD(gtk, widget, query_geometry);
-
- /* progress gauge */
- INITIALIZE_DEVICE_IIFORMAT(gtk, progress_gauge);
- IIFORMAT_HAS_DEVMETHOD(gtk, progress_gauge, redisplay);
- IIFORMAT_HAS_DEVMETHOD(gtk, progress_gauge, instantiate);
- IIFORMAT_HAS_SHARED_DEVMETHOD(gtk, progress_gauge, query_geometry,
- widget);
- /* 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);
- IIFORMAT_HAS_SHARED_DEVMETHOD(gtk, tab_control, query_geometry, widget);
- /* 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(Vsxemacs_logo, sxemacs);
- 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 gtk_glyphs_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;
-
- gtk_glyphs_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 (gtk_glyphs_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 SXEmacs
-
-SXEmacs 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 3 of the License, or
-(at your option) any later version.
-
-SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>. */
-
-
-/* Synched up with: Not in FSF. */
-/* Gtk version by William Perry */
-
-#ifndef _XEMACS_GLYPHS_GTK_H_
-#define _XEMACS_GLYPHS_GTK_H_
-
-#include "ui/glyphs.h"
-
-#ifdef HAVE_GTK
-
-#include <gtk/gtk.h>
-
-/****************************************************************************
- * Image-Instance Object *
- ****************************************************************************/
-
-struct gtk_image_instance_data {
- GdkPixmap **pixmaps;
- 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) (IMAGE_INSTANCE_PIXMAP_MASK (i))
-#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
-/* 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 "ui/window.h"
-#include "ui/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);
- }
-}
-
-/* Assign a size and position to the child widgets. This differs from the
- super class method in that for all widgets except the scrollbars the size
- and position are not caclulated here. This is because these widgets have
- this function performed for them by the redisplay code (see
- gtk_map_subwindow()). If the superclass method is called then the widgets
- can change size and position as the two pieces of code move the widgets at
- random.
-*/
-static void
-gtk_xemacs_size_allocate(GtkWidget * widget, GtkAllocation * allocation)
-{
- GtkXEmacs *x = GTK_XEMACS(widget);
- GtkFixed *fixed = GTK_FIXED(widget);
- struct frame *f = GTK_XEMACS_FRAME(x);
- int columns, rows;
- GList *children;
- guint16 border_width;
-
- widget->allocation = *allocation;
- if (GTK_WIDGET_REALIZED(widget))
- gdk_window_move_resize(widget->window,
- allocation->x,
- allocation->y,
- allocation->width, allocation->height);
-
- border_width = GTK_CONTAINER(fixed)->border_width;
-
- children = fixed->children;
- while (children) {
- GtkFixedChild *child = children->data;
- children = children->next;
-
- /*
- Scrollbars are the only widget that is managed by GTK. See
- comments in gtk_create_scrollbar_instance().
- */
- if (GTK_WIDGET_VISIBLE(child->widget) &&
- gtk_type_is_a(GTK_OBJECT_TYPE(child->widget),
- GTK_TYPE_SCROLLBAR)) {
- GtkAllocation child_allocation;
- GtkRequisition child_requisition;
-
- gtk_widget_get_child_requisition(child->widget,
- &child_requisition);
- child_allocation.x = child->x + border_width;
- child_allocation.y = child->y + border_width;
- child_allocation.width = child_requisition.width;
- child_allocation.height = child_requisition.height;
- gtk_widget_size_allocate(child->widget,
- &child_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);
-
- if (GTK_WIDGET_DRAWABLE(widget))
- 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. */
-
- if (GTK_WIDGET_DRAWABLE(widget)) {
- 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;
-
- if (GTK_WIDGET_DRAWABLE(widget)) {
- /* 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);
- }
-
- return FALSE;
-}
-
-Lisp_Object xemacs_gtk_convert_color(GdkColor * c, GtkWidget * w)
-{
- char color_buf[16];
-
- int sz = snprintf(color_buf, sizeof(color_buf),
- "#%04x%04x%04x", c->red, c->green, c->blue);
- assert(sz >= 0 && sz < sizeof(color_buf));
- 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 "ui/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 SXEmacs
-
-SXEmacs 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 3 of the License, or
-(at your option) any later version.
-
-SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>. */
-
-
-/* Synched up with: Not in FSF. */
-
-#include <config.h>
-#include "lisp.h"
-
-#include "console-gtk.h"
-#include "gui-gtk.h"
-#include "buffer.h"
-#include "ui/device.h"
-#include "ui/frame.h"
-#include "ui/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 SXEmacs
-
-SXEmacs 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 3 of the License, or
-(at your option) any later version.
-
-SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>. */
-
-
-/* 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 -- Gtk interface.
- Copyright (C) 1993, 1994 Free Software Foundation, Inc.
- Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
-
-This file is part of SXEmacs
-
-SXEmacs 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 3 of the License, or
-(at your option) any later version.
-
-SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>. */
-
-
-/* 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 "ui/gui.h"
-#include "events/events.h"
-#include "ui/frame.h"
-#include "opaque.h"
-#include "ui/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,
- GtkAccelGroup * accel_group);
-
-#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 *menubar_parent_class;
-
-static void gtk_xemacs_menubar_class_init(GtkXEmacsMenubarClass * klass)
-{
- GtkWidgetClass *widget_class;
-
- widget_class = (GtkWidgetClass *) klass;
- menubar_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;
-
- menubar_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
-/*
- * Label with XEmacs accelerator character support.
- *
- * The default interfaces to GtkAccelLabel does not understand XEmacs
- * keystroke printing conventions, nor is it convenient in the places where is
- * it needed. This subclass provides an alternative interface more suited to
- * XEmacs needs but does not add new functionality.
- */
-#define GTK_TYPE_XEMACS_ACCEL_LABEL (gtk_xemacs_accel_label_get_type ())
-#define GTK_XEMACS_ACCEL_LABEL(obj) (GTK_CHECK_CAST ((obj), GTK_TYPE_ACCEL_LABEL, GtkXEmacsAccelLabel))
-#define GTK_XEMACS_ACCEL_LABEL_CLASS(klass) (GTK_CHECK_CLASS_CAST ((klass), GTK_TYPE_ACCEL_LABEL, GtkXEmacsAccelLabelClass))
-#define GTK_IS_XEMACS_ACCEL_LABEL(obj) (GTK_CHECK_TYPE ((obj), GTK_TYPE_XEMACS_ACCEL_LABEL))
-#define GTK_IS_XEMACS_ACCEL_LABEL_CLASS(klass) (GTK_CHECK_CLASS_TYPE ((klass), GTK_TYPE_XEMACS_ACCEL_LABEL))
-
-typedef struct _GtkXEmacsAccelLabel GtkXEmacsAccelLabel;
-typedef struct _GtkXEmacsAccelLabelClass GtkXEmacsAccelLabelClass;
-
-/* Instance structure. No additional fields required. */
-struct _GtkXEmacsAccelLabel {
- GtkAccelLabel label;
-};
-
-/* Class structure. No additional fields required. */
-struct _GtkXEmacsAccelLabelClass {
- GtkAccelLabelClass parent_class;
-};
-
-static GtkType gtk_xemacs_accel_label_get_type(void);
-static GtkWidget *gtk_xemacs_accel_label_new(const gchar * string);
-static void gtk_xemacs_set_accel_keys(GtkXEmacsAccelLabel * l,
- Lisp_Object keys);
-static void gtk_xemacs_accel_label_class_init(GtkXEmacsAccelLabelClass * klass);
-static void gtk_xemacs_accel_label_init(GtkXEmacsAccelLabel * xemacs);
-
-static GtkType gtk_xemacs_accel_label_get_type(void)
-{
- static GtkType xemacs_accel_label_type = 0;
-
- if (!xemacs_accel_label_type) {
- static const GtkTypeInfo xemacs_accel_label_info = {
- "GtkXEmacsAccelLabel",
- sizeof(GtkXEmacsAccelLabel),
- sizeof(GtkXEmacsAccelLabelClass),
- (GtkClassInitFunc) gtk_xemacs_accel_label_class_init,
- (GtkObjectInitFunc) gtk_xemacs_accel_label_init,
- /* reserved_1 */ NULL,
- /* reserved_2 */ NULL,
- (GtkClassInitFunc) NULL,
- };
-
- xemacs_accel_label_type =
- gtk_type_unique(gtk_accel_label_get_type(),
- &xemacs_accel_label_info);
- }
-
- return xemacs_accel_label_type;
-}
-
-static void gtk_xemacs_accel_label_class_init(GtkXEmacsAccelLabelClass * klass)
-{
- /* Nothing to do. */
-}
-
-static void gtk_xemacs_accel_label_init(GtkXEmacsAccelLabel * xemacs)
-{
- /* Nothing to do. */
-}
-
-static GtkWidget *gtk_xemacs_accel_label_new(const gchar * string)
-{
- GtkXEmacsAccelLabel *xemacs_accel_label;
-
- xemacs_accel_label = gtk_type_new(GTK_TYPE_XEMACS_ACCEL_LABEL);
-
- if (string && *string)
- gtk_label_set_text(GTK_LABEL(xemacs_accel_label), string);
-
- return GTK_WIDGET(xemacs_accel_label);
-}
-
-/* Make the string <keys> the accelerator string for the label. */
-static void gtk_xemacs_set_accel_keys(GtkXEmacsAccelLabel * l, Lisp_Object keys)
-{
- g_return_if_fail(l != NULL);
- g_return_if_fail(GTK_IS_XEMACS_ACCEL_LABEL(l));
-
- /* Disable the standard way of finding the accelerator string for the
- label. */
- gtk_accel_label_set_accel_widget(GTK_ACCEL_LABEL(l), NULL);
-
- /* Set the string straight from the object. */
- if (STRINGP(keys) && XSTRING_LENGTH(keys)) {
- C_STRING_TO_EXTERNAL_MALLOC(XSTRING_DATA(keys),
- l->label.accel_string, Qctext);
- } else {
- /* l->label.accel_string = NULL; */
- }
-}
-\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,
- gtk_menu_ensure_uline_accel_group
- (GTK_MENU
- (item->submenu)));
- }
-
- 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;
- }
-}
-
-/* Convert the XEmacs menu accelerator representation to Gtk mnemonic form. If
- no accelerator has been provided, put one at the start of the string (this
- mirrors the behaviour under X). This algorithm is also found in
- dialog-gtk.el:gtk-popup-convert-underscores.
-*/
-static char *convert_underscores(const char *name)
-{
- char *rval;
- int i, j;
- int found_accel = FALSE;
- int underscores = 0;
-
- for (i = 0; name[i]; ++i)
- if (name[i] == '%' && name[i + 1] == '_') {
- found_accel = TRUE;
- } else if (name[i] == '_') {
- underscores++;
- }
-
- /* Allocate space for the original string, plus zero byte plus extra space
- for all quoted underscores plus possible additional leading accelerator. */
- rval = xmalloc_and_zero(strlen(name) + 1 + underscores
- + (found_accel ? 0 : 1));
-
- if (!found_accel)
- rval[0] = '_';
-
- for (i = 0, j = (found_accel ? 0 : 1); name[i]; i++) {
- if (name[i] == '%') {
- i++;
- if (!(name[i]))
- continue;
-
- if ((name[i] != '_') && (name[i] != '%'))
- i--;
-
- found_accel = TRUE;
- } else if (name[i] == '_') {
- rval[j++] = '_';
- }
-
- rval[j++] = name[i];
- }
-
- return rval;
-}
-
-/* Remove the XEmacs menu accellerator representation from a string. */
-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] != '_') && (name[i] != '%'))
- i--;
- else
- 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,
- GtkAccelGroup * menubar_accel_group)
-{
- 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 =
- convert_underscores(XSTRING_DATA(XCAR(desc)));
- GtkWidget *accel_label =
- gtk_xemacs_accel_label_new(NULL);
- guint accel_key;
-
- gtk_misc_set_alignment(GTK_MISC(accel_label), 0.0, 0.5);
- accel_key =
- gtk_label_parse_uline(GTK_LABEL(accel_label),
- temp_menu_name);
-
- menu_item = gtk_menu_item_new();
- gtk_container_add(GTK_CONTAINER(menu_item),
- accel_label);
- gtk_widget_show(accel_label);
-
- if (menubar_accel_group)
- gtk_widget_add_accelerator(menu_item,
- "activate_item",
- menubar_accel_group,
- accel_key,
- GDK_MOD1_MASK,
- GTK_ACCEL_LOCKED);
- 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);
-}
-
-/* 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, gtk_widget_to_frame(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,
- GtkAccelGroup * accel_group)
-{
- 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, accel_group));
- } 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;
- guint accel_key;
-
- 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;
- int sz, maxsz;
-
- if (STRINGP(suffix) && XSTRING_LENGTH(suffix)) {
- maxsz = XSTRING_LENGTH(name) + 15 +
- XSTRING_LENGTH(suffix);
- label_buffer = alloca(maxsz);
- sz = snprintf(label_buffer, maxsz, "%s %s ",
- XSTRING_DATA(name),
- XSTRING_DATA(suffix));
- assert(sz>=0 && sz<maxsz);
- } else {
- maxsz = XSTRING_LENGTH(name) + 15;
- label_buffer = alloca(maxsz);
- sz = sprintf(label_buffer, maxsz, "%s ",
- XSTRING_DATA(name));
- assert(sz>=0 && sz<maxsz);
- }
-
- temp_label = convert_underscores(label_buffer);
- main_label = gtk_xemacs_accel_label_new(NULL);
- accel_key =
- gtk_label_parse_uline(GTK_LABEL(main_label),
- 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));
-
- /* Now that all the information about the menu item is know, set the
- remaining properties.
- */
-
- if (main_label) {
- gtk_container_add(GTK_CONTAINER(widget), main_label);
-
- gtk_misc_set_alignment(GTK_MISC(main_label), 0.0, 0.5);
- gtk_xemacs_set_accel_keys(GTK_XEMACS_ACCEL_LABEL
- (main_label), keys);
-
- if (accel_group)
- gtk_widget_add_accelerator(widget,
- "activate_item",
- accel_group,
- accel_key, 0,
- GTK_ACCEL_LOCKED);
- }
-
- return (widget);
- } else {
- return (NULL);
- /* abort (); ???? */
- }
-}
-
-static GtkWidget *menu_descriptor_to_widget(Lisp_Object descr,
- GtkAccelGroup * accel_group)
-{
- 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, accel_group);
- 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_xemacs_accel_label_new(), but we still double check to make
- ** sure we don't seriously foobar ourselves.
- */
- gpointer possible_child =
- g_list_nth_data(gtk_container_children(GTK_CONTAINER(child)), 0);
- gboolean ret_val = FALSE;
-
- if (possible_child && GTK_IS_LABEL(possible_child)) {
- char *temp_label = remove_underscores(label);
-
- if (!strcmp(GTK_LABEL(possible_child)->label, temp_label))
- ret_val = TRUE;
-
- free(temp_label);
- }
-
- return ret_val;
-}
-
-/* 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;
- GtkAccelGroup *menubar_accel_group;
-
- /* Remove any existing protection for old menu items */
- ungcpro_popup_callbacks(id);
-
- /* GCPRO the whole damn thing */
- gcpro_popup_callbacks(id, descr);
-
- menubar_accel_group = gtk_accel_group_new();
-
- 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,
- menubar_accel_group);
- 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),
- menubar_accel_group);
- reused_p = TRUE;
- } else {
- widget =
- menu_convert(item_descr, NULL,
- menubar_accel_group);
- 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));
- }
- }
- }
-
- /* Attach the new accelerator group to the frame. */
- gtk_window_add_accel_group(GTK_WINDOW(FRAME_GTK_SHELL_WIDGET(f)),
- menubar_accel_group);
-}
-\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 = NULL;
- GtkWidget *menu = NULL;
- gpointer id = NULL;
-
- /* Do basic error checking first... */
- if (SYMBOLP(menu_desc))
- menu_desc = Fsymbol_value(menu_desc);
- CHECK_CONS(menu_desc);
- CHECK_STRING(XCAR(menu_desc));
-
- /* Now lets get down to business... */
- widget = menu_descriptor_to_widget(menu_desc, NULL);
- menu = GTK_MENU_ITEM(widget)->submenu;
- gtk_widget_set_name(widget, "XEmacsPopupMenu");
- id = gtk_object_get_data(GTK_OBJECT(widget), XEMACS_MENU_GUIID_TAG);
-
- __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, NULL);
-
- 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 SXEmacs
-
-SXEmacs 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 3 of the License, or
-(at your option) any later version.
-
-SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>. */
-
-
-/* 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 "ui/faces.h"
-#include "ui/frame.h"
-#include "ui/toolbar.h"
-#include "ui/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 SXEmacs
-
-SXEmacs 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 3 of the License, or
-(at your option) any later version.
-
-SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>. */
-
-
-/* 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 "ui/device.h"
-#include "ui/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)
-{
- GdkColor *color = COLOR_INSTANCE_GTK_COLOR(c);
- write_fmt_str(printcharfun, " %ld=(%X,%X,%X)",
- color->pixel, color->red, color->green, color->blue);
-}
-
-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)
-{
- write_fmt_str(printcharfun, " 0x%lx",
- (unsigned long)gdk_font_id(FONT_INSTANCE_GTK_FONT(f)));
-}
-
-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 SXEmacs
-
-SXEmacs 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 3 of the License, or
-(at your option) any later version.
-
-SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>. */
-
-
-/* Synched up with: Not in FSF. */
-/* Gtk version by William Perry */
-
-#ifndef _XEMACS_OBJECTS_GTK_H_
-#define _XEMACS_OBJECTS_GTK_H_
-
-#include "ui/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 SXEmacs
-
-SXEmacs 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 3 of the License, or
-(at your option) any later version.
-
-SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>. */
-
-
-/* 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 "ui/faces.h"
-#include "ui/frame.h"
-#include "ui/gutter.h"
-#include "ui/redisplay.h"
-#include "sysdep.h"
-#include "ui/window.h"
-
-#include "sysproc.h" /* for select() */
-
-#ifdef MULE
-#include "mule/mule-ccl.h"
-#include "mule/file-coding.h" /* for CCL conversion */
-#endif
-
-#ifdef HAVE_POLL
-#include <sys/poll.h>
-#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 = NULL;
- 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);
- buf = Dynarr_new(Emchar);
-
- 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,
- rb->object.
- dglyph.
- yoffset,
- 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 -- GTK 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 SXEmacs
-
-SXEmacs 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 3 of the License, or
-(at your option) any later version.
-
-SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>. */
-
-
-/* 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 "ui/frame.h"
-#include "ui/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), GTK_DATA_GUI_IDENTIFIER,
- (void *)SCROLLBAR_GTK_ID(instance));
- gtk_object_set_data(GTK_OBJECT(adj), GTK_DATA_FRAME_IDENTIFIER, f);
- gtk_object_set_data(GTK_OBJECT(adj), "xemacs::sb_instance", instance);
-
- sb = GTK_SCROLLBAR(vertical ? gtk_vscrollbar_new(adj) :
- gtk_hscrollbar_new(adj));
- /* With gtk version > 1.2.8 the gtk code does not call
- gtk_widget_request_size() on the newly created scrollbars
- anymore (catering to theme engines).
- #### Maybe it is better to postpone this call to just before
- gtk_widget_show() is called on the scrollbar? */
-#if GTK_MAJOR_VERSION == 1 && GTK_MINOR_VERSION == 2 && GTK_BINARY_AGE > 8
- gtk_widget_size_request(GTK_WIDGET(sb), &(GTK_WIDGET(sb)->requisition));
-#endif
- 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);
-
- /*
- UGLY! UGLY! UGLY! Changes to wid->allocation are queued and
- not performed until the GTK event loop. However, when the
- fontlock progress bar is run, the vertical scrollbar's height
- is change and then changed back before events are again
- processed. This means that the change back is not seen and
- the scrollbar is left too short. Fix this by making the
- change manually so the test above sees the change. This does
- not seem to cause problems in other cases.
- */
-
- wid->allocation.width =
- pos_data->scrollbar_width;
- wid->allocation.height =
- 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);
-
- /*
- UGLY! UGLY! UGLY! Changes to wid->allocation are queued and
- not performed until the GTK event loop. However, when the
- fontlock progress bar is run, the horizontal scrollbar's
- position is change and then changed back before events are
- again processed. This means that the change back is not seen
- and the scrollbar is left in the wrong position. Fix this by
- making the change manually so the test above sees the change.
- This does not seem to cause problems in other cases.
- */
-
- wid->allocation.x = pos_data->scrollbar_x;
- wid->allocation.y = 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), GTK_DATA_FRAME_IDENTIFIER);
- 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),
- GTK_DATA_GUI_IDENTIFIER);
- 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 SXEmacs
-
-SXEmacs 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 3 of the License, or
-(at your option) any later version.
-
-SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>. */
-
-
-/* Synched up with: Not in FSF. */
-
-#ifndef _XEMACS_SCROLLBAR_GTK_H_
-#define _XEMACS_SCROLLBAR_GTK_H_
-
-#if defined (HAVE_GTK) && defined (HAVE_SCROLLBARS)
-
-#include "ui/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 SXEmacs
- Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
-
-This file is part of SXEmacs
-
-SXEmacs 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 3 of the License, or
-(at your option) any later version.
-
-SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>. */
-
-
-/* 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/events.h"
-#include "buffer.h"
-#include "ui/device.h"
-#include "console-gtk.h"
-#include "ui/select.h"
-#include "opaque.h"
-#include "ui/frame.h"
-
-int lisp_to_time(Lisp_Object, time_t *);
-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);
- }
- }
-}
-
-void
-emacs_gtk_selection_clear_event_handle(GtkWidget * widget,
- GdkEventSelection * event, gpointer data)
-{
- GdkAtom selection = event->selection;
- guint32 changed_owner_time = event->time;
- struct device *d = decode_gtk_device(Qnil);
-
- Lisp_Object selection_symbol, local_selection_time_lisp;
- guint32 local_selection_time;
-
- selection_symbol = atom_to_symbol(d, selection);
-
- local_selection_time_lisp = Fget_selection_timestamp(selection_symbol);
-
- /* We don't own the selection, so that's fine. */
- if (NILP(local_selection_time_lisp))
- return;
-
- local_selection_time =
- *(guint32 *) XOPAQUE_DATA(local_selection_time_lisp);
-
- /* This SelectionClear is for a selection that we no longer own, so we can
- disregard it. (That is, we have reasserted the selection since this
- request was generated.)
- */
- if (changed_owner_time != GDK_CURRENT_TIME &&
- local_selection_time > changed_owner_time)
- return;
-
- handle_selection_clear(selection_symbol);
-}
-\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 SXEmacs
-
-SXEmacs 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 3 of the License, or
-(at your option) any later version.
-
-SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>. */
-
-
-/* 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 "ui/faces.h"
-#include "ui/frame.h"
-#include "ui/toolbar.h"
-#include "ui/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 \
- || f->clear) /* This is clearly necessary. */ \
- { \
- 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);
- if (FRAME_REAL_BOTTOM_TOOLBAR_VISIBLE(f))
- gtk_output_toolbar(f, BOTTOM_TOOLBAR);
- if (FRAME_REAL_LEFT_TOOLBAR_VISIBLE(f))
- gtk_output_toolbar(f, LEFT_TOOLBAR);
- if (FRAME_REAL_RIGHT_TOOLBAR_VISIBLE(f))
- gtk_output_toolbar(f, RIGHT_TOOLBAR);
-}
-
-static void gtk_clear_frame_toolbars(struct frame *f)
-{
- assert(FRAME_GTK_P(f));
-
- if (f->top_toolbar_was_visible && !FRAME_REAL_TOP_TOOLBAR_VISIBLE(f))
- gtk_clear_toolbar(f, TOP_TOOLBAR, 0);
- if (f->bottom_toolbar_was_visible
- && !FRAME_REAL_BOTTOM_TOOLBAR_VISIBLE(f))
- gtk_clear_toolbar(f, BOTTOM_TOOLBAR, 0);
- if (f->left_toolbar_was_visible && !FRAME_REAL_LEFT_TOOLBAR_VISIBLE(f))
- gtk_clear_toolbar(f, LEFT_TOOLBAR, 0);
- if (f->right_toolbar_was_visible
- && !FRAME_REAL_RIGHT_TOOLBAR_VISIBLE(f))
- 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, clear_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 "ui/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 "ui/device.h"
-#include "ui/window.h"
-#include "glyphs-gtk.h"
-#include "objects-gtk.h"
-#include "ui-gtk.h"
-#include "ui/faces.h"
-#include "gui-gtk.h"
-#include "sysdll.h"
-#include "hash.h"
-#include "events/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);
-int lisp_to_gtk_ret_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)
-{
- 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)
- write_fmt_str(printcharfun, " %d arguments", XFFI(obj)->n_args);
- write_fmt_str(printcharfun, " %p>", (void *)XFFI(obj)->function_ptr);
-}
-
-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)
-{
- 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);
- write_fmt_st(printcharfun, ") %p>", (void *)XGTK_OBJECT(obj)->object);
-}
-
-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, GTK_DATA_GUI_IDENTIFIER);
-
- 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, GTK_DATA_GUI_IDENTIFIER,
- (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_ret_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)
-{
- if (print_readably)
- error("printing unreadable object #<GtkBoxed %p>",
- XGTK_BOXED(obj)->object);
-
- write_fmt_string(printcharfun, "#<GtkBoxed (%s) %p>",
- gtk_type_name(XGTK_BOXED(obj)->object_type),
- (void *)XGTK_BOXED(obj)->object);
-
-}
-
-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:
-#ifdef WITH_NUMBER_TYPES
- CHECK_NUMBER(obj);
-#else
- CHECK_INT_OR_FLOAT(obj);
-#endif
- GTK_VALUE_FLOAT(*arg) = extract_float(obj);
- break;
- case GTK_TYPE_DOUBLE:
-#ifdef WITH_NUMBER_TYPES
- CHECK_NUMBER(obj);
-#else
- CHECK_INT_OR_FLOAT(obj);
-#endif
- 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);
-}
-
-/* Convert lisp types to GTK return types. This is identical to
- lisp_to_gtk_type() except that the macro used to set the value is
- different.
-
- ### There should be some way of combining these two functions.
-*/
-int lisp_to_gtk_ret_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_RETLOC_CHAR(*arg)) = c;
- }
- break;
- case GTK_TYPE_UCHAR:
- {
- Emchar c;
-
- CHECK_CHAR_COERCE_INT(obj);
- c = XCHAR(obj);
- *(GTK_RETLOC_CHAR(*arg)) = c;
- }
- break;
- case GTK_TYPE_BOOL:
- *(GTK_RETLOC_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_RETLOC_INT(*arg)) = NILP(obj) ? 0 : 1;
- } else {
- CHECK_INT(obj);
- *(GTK_RETLOC_INT(*arg)) = XINT(obj);
- }
- break;
- case GTK_TYPE_LONG:
- case GTK_TYPE_ULONG:
- abort();
- case GTK_TYPE_FLOAT:
-#ifdef WITH_NUMBER_TYPES
- CHECK_NUMBER(obj);
-#else
- CHECK_INT_OR_FLOAT(obj);
-#endif
- *(GTK_RETLOC_FLOAT(*arg)) = extract_float(obj);
- break;
- case GTK_TYPE_DOUBLE:
-#ifdef WITH_NUMBER_TYPES
- CHECK_NUMBER(obj);
-#else
- CHECK_INT_OR_FLOAT(obj);
-#endif
- *(GTK_RETLOC_DOUBLE(*arg)) = extract_float(obj);
- break;
- case GTK_TYPE_STRING:
- if (NILP(obj))
- *(GTK_RETLOC_STRING(*arg)) = NULL;
- else {
- CHECK_STRING(obj);
- *(GTK_RETLOC_STRING(*arg)) = (char *)XSTRING_DATA(obj);
- }
- break;
- case GTK_TYPE_ENUM:
- case GTK_TYPE_FLAGS:
- /* Convert a lisp symbol to a GTK enum */
- *(GTK_RETLOC_ENUM(*arg)) = lisp_to_flag(obj, arg->type);
- break;
- case GTK_TYPE_BOXED:
- if (NILP(obj)) {
- *(GTK_RETLOC_BOXED(*arg)) = NULL;
- } else if (GTK_BOXEDP(obj)) {
- *(GTK_RETLOC_BOXED(*arg)) = XGTK_BOXED(obj)->object;
- } else if (arg->type == GTK_TYPE_STYLE) {
- obj = Ffind_face(obj);
- CHECK_FACE(obj);
- *(GTK_RETLOC_BOXED(*arg)) = face_to_style(obj);
- } else if (arg->type == GTK_TYPE_GDK_GC) {
- obj = Ffind_face(obj);
- CHECK_FACE(obj);
- *(GTK_RETLOC_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_RETLOC_BOXED(*arg)) = NULL;
- break;
-
- case IMAGE_MONO_PIXMAP:
- case IMAGE_COLOR_PIXMAP:
- *(GTK_RETLOC_BOXED(*arg)) =
- IMAGE_INSTANCE_GTK_PIXMAP(p);
- break;
- }
- } else if (GTK_OBJECTP(obj)
- && GTK_IS_WIDGET(XGTK_OBJECT(obj)->object)) {
- *(GTK_RETLOC_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_RETLOC_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_RETLOC_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_RETLOC_BOXED(*arg)) = NULL;
- }
- break;
-
- case GTK_TYPE_POINTER:
- if (NILP(obj))
- *(GTK_RETLOC_POINTER(*arg)) = NULL;
- else
- *(GTK_RETLOC_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_RETLOC_CALLBACK(*arg)).marshal =
- __internal_callback_marshal;
- *(GTK_RETLOC_CALLBACK(*arg)).data = (gpointer) obj;
- *(GTK_RETLOC_CALLBACK(*arg)).notify =
- __internal_callback_destroy;
- }
- break;
-#endif
-
- /* base type of the object system */
- case GTK_TYPE_OBJECT:
- if (NILP(obj))
- *(GTK_RETLOC_OBJECT(*arg)) = NULL;
- else {
- CHECK_GTK_OBJECT(obj);
- if (XGTK_OBJECT(obj)->alive_p)
- *(GTK_RETLOC_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_RETLOC_POINTER(*arg)) = NULL;
- else {
- xemacs_list_to_array(obj, arg);
- }
- } else if (GTK_FUNDAMENTAL_TYPE(arg->type) == GTK_TYPE_LISTOF) {
- if (NILP(obj))
- *(GTK_RETLOC_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 SXEmacs.
-
-;; SXEmacs 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 3 of the License, or (at your
-;; option) any later version.
-
-;; SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; 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)))