git.chise.org Git - chise/xemacs-chise.git-/blob - src/glade.c

   1 /* glade.c
   2 **
   3 ** Description: Interface to `libglade' for XEmacs/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     {
  39       /* Look for a lisp function called HANDLER_NAME */
  40       func = intern (handler_name);
  41     }
  42
  43   if (signal_data && signal_data[0])
  44     {
  45       lisp_data = Feval (Fread (build_string (signal_data)));
  46     }
  47
  48   /* obj, name, func, cb_data, object_signal, after_p */
  49   Fgtk_signal_connect (build_gtk_object (object),
  50                        intern (signal_name),
  51                        func,
  52                        lisp_data,
  53                        connect_object ? Qt : Qnil,
  54                        after ? Qt : Qnil);
  55 }
  56
  57 /* This differs from lisp/subr.el (functionp) definition by allowing
  58 ** symbol names that may not necessarily be fboundp yet.
  59 */
  60 static int __almost_functionp (Lisp_Object obj)
  61 {
  62   return (SYMBOLP (obj) ||
  63           SUBRP (obj) ||
  64           COMPILED_FUNCTIONP (obj) ||
  65           EQ (Fcar_safe (obj), Qlambda));
  66 }
  67
  68 DEFUN ("glade-xml-signal-connect", Fglade_xml_signal_connect, 3, 3, 0, /*
  69 Connect a glade handler.
  70 */
  71        (xml, handler_name, func))
  72 {
  73   CHECK_GTK_OBJECT (xml);
  74   CHECK_STRING (handler_name);
  75
  76   if (!__almost_functionp (func))
  77     {
  78       func = wrong_type_argument (intern ("functionp"), func);
  79     }
  80
  81   glade_xml_signal_connect_full (GLADE_XML (XGTK_OBJECT (xml)->object),
  82                                  XSTRING_DATA (handler_name),
  83                                  connector, LISP_TO_VOID (func));
  84   return (Qt);
  85 }
  86
  87 DEFUN ("glade-xml-signal-autoconnect", Fglade_xml_signal_autoconnect, 1, 1, 0, /*
  88 Connect all glade handlers.
  89 */
  90        (xml))
  91 {
  92   CHECK_GTK_OBJECT (xml);
  93
  94   glade_xml_signal_autoconnect_full (GLADE_XML (XGTK_OBJECT (xml)->object),
  95                                      connector, LISP_TO_VOID (Qnil));
  96   return (Qt);
  97 }
  98
  99 DEFUN ("glade-xml-textdomain", Fglade_xml_textdomain, 1, 1, 0, /*
 100 Return the textdomain of a GladeXML object.
 101 */
 102        (xml))
 103 {
 104   gchar *the_domain = NULL;
 105
 106   CHECK_GTK_OBJECT (xml);
 107
 108   if (!GLADE_IS_XML (XGTK_OBJECT (xml)->object))
 109     {
 110       signal_simple_error ("Object is not a GladeXML type.", xml);
 111     }
 112
 113 #ifdef LIBGLADE_XML_TXTDOMAIN
 114   the_domain = GLADE_XML (XGTK_OBJECT (xml)->object)->txtdomain;
 115 #else
 116   the_domain = GLADE_XML (XGTK_OBJECT (xml)->object)->textdomain;
 117 #endif
 118   return (build_string (the_domain));
 119 }
 120
 121 void syms_of_glade (void)
 122 {
 123   DEFSUBR (Fglade_xml_signal_connect);
 124   DEFSUBR (Fglade_xml_signal_autoconnect);
 125   DEFSUBR (Fglade_xml_textdomain);
 126 }
 127
 128 void vars_of_glade (void)
 129 {
 130   Fprovide (intern ("glade"));
 131 }
 132
 133 #else /* !(HAVE_GLADE_H || HAVE_GLADE_GLADE_H) */
 134 #define syms_of_glade()
 135 #define vars_of_glade()
 136 #endif