cgit.sxemacs.org Git - sxemacs/blob - src/glade.c

   1 /* glade.c
   2 **
   3 ** Description: Interface to `libglade' for SXEmacs/GTK
   4 **
   5 ** Created by: William M. Perry <wmperry@gnu.org>
   6 **
   7 ** Copyright (C) 1999 John Harper <john@dcs.warwick.ac.uk>
   8 ** Copyright (c) 2000 Free Software Foundation
   9 **
  10 */
  11
  12 #if defined(HAVE_GLADE_H) || defined(HAVE_GLADE_GLADE_H)
  13
  14 /* For COMPILED_FUNCTIONP */
  15 #include "bytecode.h"
  16
  17 #ifdef HAVE_GLADE_GLADE_H
  18 #include <glade/glade.h>
  19 #endif
  20
  21 #ifdef HAVE_GLADE_H
  22 #include <glade.h>
  23 #endif
  24
  25 /* This is based on the code from rep-gtk 0.11 in libglade-support.c */
  26
  27 static void
  28 connector(const gchar * handler_name, GtkObject * object,
  29           const gchar * signal_name, const gchar * signal_data,
  30           GtkObject * connect_object, gboolean after, gpointer user_data)
  31 {
  32         Lisp_Object func;
  33         Lisp_Object lisp_data = Qnil;
  34
  35         VOID_TO_LISP(func, user_data);
  36
  37         if (NILP(func)) {
  38                 /* Look for a lisp function called HANDLER_NAME */
  39                 func = intern(handler_name);
  40         }
  41
  42         if (signal_data && signal_data[0]) {
  43                 lisp_data = Feval(Fread(build_string(signal_data)));
  44         }
  45
  46         /* obj, name, func, cb_data, object_signal, after_p */
  47         Fgtk_signal_connect(build_gtk_object(object),
  48                             intern(signal_name),
  49                             func,
  50                             lisp_data,
  51                             connect_object ? Qt : Qnil, after ? Qt : Qnil);
  52 }
  53
  54 /* This differs from lisp/subr.el (functionp) definition by allowing
  55 ** symbol names that may not necessarily be fboundp yet.
  56 */
  57 static int __almost_functionp(Lisp_Object obj)
  58 {
  59         return (SYMBOLP(obj) ||
  60                 SUBRP(obj) ||
  61                 COMPILED_FUNCTIONP(obj) || EQ(Fcar_safe(obj), Qlambda));
  62 }
  63
  64 DEFUN("glade-xml-signal-connect", Fglade_xml_signal_connect, 3, 3, 0,   /*
  65 Connect a glade handler.
  66 */
  67       (xml, handler_name, func))
  68 {
  69         CHECK_GTK_OBJECT(xml);
  70         CHECK_STRING(handler_name);
  71
  72         if (!__almost_functionp(func)) {
  73                 func = wrong_type_argument(intern("functionp"), func);
  74         }
  75
  76         glade_xml_signal_connect_full(GLADE_XML(XGTK_OBJECT(xml)->object),
  77                                       XSTRING_DATA(handler_name),
  78                                       connector, LISP_TO_VOID(func));
  79         return (Qt);
  80 }
  81
  82 DEFUN("glade-xml-signal-autoconnect", Fglade_xml_signal_autoconnect, 1, 1, 0,   /*
  83 Connect all glade handlers.
  84 */
  85       (xml))
  86 {
  87         CHECK_GTK_OBJECT(xml);
  88
  89         glade_xml_signal_autoconnect_full(GLADE_XML(XGTK_OBJECT(xml)->object),
  90                                           connector, LISP_TO_VOID(Qnil));
  91         return (Qt);
  92 }
  93
  94 DEFUN("glade-xml-textdomain", Fglade_xml_textdomain, 1, 1, 0,   /*
  95 Return the textdomain of a GladeXML object.
  96 */
  97       (xml))
  98 {
  99         gchar *the_domain = NULL;
 100
 101         CHECK_GTK_OBJECT(xml);
 102
 103         if (!GLADE_IS_XML(XGTK_OBJECT(xml)->object)) {
 104                 signal_simple_error("Object is not a GladeXML type.", xml);
 105         }
 106 #ifdef LIBGLADE_XML_TXTDOMAIN
 107         the_domain = GLADE_XML(XGTK_OBJECT(xml)->object)->txtdomain;
 108 #else
 109         the_domain = GLADE_XML(XGTK_OBJECT(xml)->object)->textdomain;
 110 #endif
 111         return (build_string(the_domain));
 112 }
 113
 114 void syms_of_glade(void)
 115 {
 116         DEFSUBR(Fglade_xml_signal_connect);
 117         DEFSUBR(Fglade_xml_signal_autoconnect);
 118         DEFSUBR(Fglade_xml_textdomain);
 119 }
 120
 121 void vars_of_glade(void)
 122 {
 123         Fprovide(intern("glade"));
 124 }
 125
 126 #else                           /* !(HAVE_GLADE_H || HAVE_GLADE_GLADE_H) */
 127 #define syms_of_glade()
 128 #define vars_of_glade()
 129 #endif