Mercurial > hg > xemacs-beta

comparison src/ui-gtk.c @ 1883:c347bc6e2cb3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2004-01-27 13:13:42 by stephent] gtk button fix <87isixo7sl.fsf_-_@tleepslib.sk.tsukuba.ac.jp>
author stephent
date Tue, 27 Jan 2004 13:13:45 +0000
parents 3fe1a35b705d
children 91d4c8c65a0f
comparison
equal deleted inserted replaced
1882:01dce9d37966 1883:c347bc6e2cb3
35 35
36 static GHashTable *dll_cache; 36 static GHashTable *dll_cache;
37 37
38 Lisp_Object gtk_type_to_lisp (GtkArg *arg); 38 Lisp_Object gtk_type_to_lisp (GtkArg *arg);
39 int lisp_to_gtk_type (Lisp_Object obj, GtkArg *arg); 39 int lisp_to_gtk_type (Lisp_Object obj, GtkArg *arg);
40 int lisp_to_gtk_ret_type (Lisp_Object obj, GtkArg *arg);
40 #if 0 41 #if 0
41 void describe_gtk_arg (GtkArg *arg); 42 void describe_gtk_arg (GtkArg *arg);
42 #endif 43 #endif
43 guint symbol_to_enum (Lisp_Object obj, GtkType t); 44 guint symbol_to_enum (Lisp_Object obj, GtkType t);
44 static guint lisp_to_flag (Lisp_Object obj, GtkType t); 45 static guint lisp_to_flag (Lisp_Object obj, GtkType t);
1040 1041
1041 rval = Fapply (2, newargs); 1042 rval = Fapply (2, newargs);
1042 signal_fake_event (); 1043 signal_fake_event ();
1043 1044
1044 if (args[n_args].type != GTK_TYPE_NONE) 1045 if (args[n_args].type != GTK_TYPE_NONE)
1045 lisp_to_gtk_type (rval, &args[n_args]); 1046 lisp_to_gtk_ret_type (rval, &args[n_args]);
1046 1047
1047 UNGCPRO; 1048 UNGCPRO;
1048 } 1049 }
1049 1050
1050 DEFUN ("gtk-signal-connect", Fgtk_signal_connect, 3, 6, 0, /* 1051 DEFUN ("gtk-signal-connect", Fgtk_signal_connect, 3, 6, 0, /*
1805 } 1806 }
1806 1807
1807 return (0); 1808 return (0);
1808 } 1809 }
1809 1810
1811 /* Convert lisp types to GTK return types. This is identical to
1812 lisp_to_gtk_type() except that the macro used to set the value is
1813 different.
1814
1815 ### There should be some way of combining these two functions.
1816 */
1817 int lisp_to_gtk_ret_type (Lisp_Object obj, GtkArg *arg)
1818 {
1819 switch (GTK_FUNDAMENTAL_TYPE (arg->type))
1820 {
1821 /* flag types */
1822 case GTK_TYPE_NONE:
1823 return (0);
1824 case GTK_TYPE_CHAR:
1825 {
1826 Ichar c;
1827
1828 CHECK_CHAR_COERCE_INT (obj);
1829 c = XCHAR (obj);
1830 *(GTK_RETLOC_CHAR (*arg)) = c;
1831 }
1832 break;
1833 case GTK_TYPE_UCHAR:
1834 {
1835 Ichar c;
1836
1837 CHECK_CHAR_COERCE_INT (obj);
1838 c = XCHAR (obj);
1839 *(GTK_RETLOC_CHAR (*arg)) = c;
1840 }
1841 break;
1842 case GTK_TYPE_BOOL:
1843 *(GTK_RETLOC_BOOL (*arg)) = NILP (obj) ? FALSE : TRUE;
1844 break;
1845 case GTK_TYPE_INT:
1846 case GTK_TYPE_UINT:
1847 if (NILP (obj) || EQ (Qt, obj))
1848 {
1849 /* For we are a kind mistress and allow sending t/nil for
1850 1/0 to stupid GTK functions that say they take guint or
1851 gint in the header files, but actually treat it like a
1852 bool. *sigh*
1853 */
1854 *(GTK_RETLOC_INT(*arg)) = NILP (obj) ? 0 : 1;
1855 }
1856 else
1857 {
1858 CHECK_INT (obj);
1859 *(GTK_RETLOC_INT(*arg)) = XINT (obj);
1860 }
1861 break;
1862 case GTK_TYPE_LONG:
1863 case GTK_TYPE_ULONG:
1864 abort();
1865 case GTK_TYPE_FLOAT:
1866 CHECK_INT_OR_FLOAT (obj);
1867 *(GTK_RETLOC_FLOAT(*arg)) = extract_float (obj);
1868 break;
1869 case GTK_TYPE_DOUBLE:
1870 CHECK_INT_OR_FLOAT (obj);
1871 *(GTK_RETLOC_DOUBLE(*arg)) = extract_float (obj);
1872 break;
1873 case GTK_TYPE_STRING:
1874 if (NILP (obj))
1875 *(GTK_RETLOC_STRING (*arg)) = NULL;
1876 else
1877 {
1878 CHECK_STRING (obj);
1879 *(GTK_RETLOC_STRING (*arg)) = (char *) XSTRING_DATA (obj);
1880 }
1881 break;
1882 case GTK_TYPE_ENUM:
1883 case GTK_TYPE_FLAGS:
1884 /* Convert a lisp symbol to a GTK enum */
1885 *(GTK_RETLOC_ENUM(*arg)) = lisp_to_flag (obj, arg->type);
1886 break;
1887 case GTK_TYPE_BOXED:
1888 if (NILP (obj))
1889 {
1890 *(GTK_RETLOC_BOXED(*arg)) = NULL;
1891 }
1892 else if (GTK_BOXEDP (obj))
1893 {
1894 *(GTK_RETLOC_BOXED(*arg)) = XGTK_BOXED (obj)->object;
1895 }
1896 else if (arg->type == GTK_TYPE_STYLE)
1897 {
1898 obj = Ffind_face (obj);
1899 CHECK_FACE (obj);
1900 *(GTK_RETLOC_BOXED(*arg)) = face_to_style (obj);
1901 }
1902 else if (arg->type == GTK_TYPE_GDK_GC)
1903 {
1904 obj = Ffind_face (obj);
1905 CHECK_FACE (obj);
1906 *(GTK_RETLOC_BOXED(*arg)) = face_to_gc (obj);
1907 }
1908 else if (arg->type == GTK_TYPE_GDK_WINDOW)
1909 {
1910 if (GLYPHP (obj))
1911 {
1912 Lisp_Object window = Fselected_window (Qnil);
1913 Lisp_Object instance =
1914 glyph_image_instance (obj, window, ERROR_ME_DEBUG_WARN, 1);
1915 struct Lisp_Image_Instance *p = XIMAGE_INSTANCE (instance);
1916
1917 switch (XIMAGE_INSTANCE_TYPE (instance))
1918 {
1919 case IMAGE_TEXT:
1920 case IMAGE_POINTER:
1921 case IMAGE_SUBWINDOW:
1922 case IMAGE_NOTHING:
1923 *(GTK_RETLOC_BOXED(*arg)) = NULL;
1924 break;
1925
1926 case IMAGE_MONO_PIXMAP:
1927 case IMAGE_COLOR_PIXMAP:
1928 *(GTK_RETLOC_BOXED(*arg)) = IMAGE_INSTANCE_GTK_PIXMAP (p);
1929 break;
1930 }
1931 }
1932 else if (GTK_OBJECTP (obj) && GTK_IS_WIDGET (XGTK_OBJECT (obj)->object))
1933 {
1934 *(GTK_RETLOC_BOXED(*arg)) = GTK_WIDGET (XGTK_OBJECT (obj))->window;
1935 }
1936 else
1937 {
1938 invalid_argument ("Don't know how to convert object to GDK_WINDOW", obj);
1939 }
1940 break;
1941 }
1942 else if (arg->type == GTK_TYPE_GDK_COLOR)
1943 {
1944 if (COLOR_SPECIFIERP (obj))
1945 {
1946 /* If it is a specifier, we just convert it to an
1947 instance, and let the ifs below handle it.
1948 */
1949 obj = Fspecifier_instance (obj, Qnil, Qnil, Qnil);
1950 }
1951
1952 if (COLOR_INSTANCEP (obj))
1953 {
1954 /* Easiest one */
1955 *(GTK_RETLOC_BOXED(*arg)) = COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (obj));
1956 }
1957 else if (STRINGP (obj))
1958 {
1959 invalid_argument ("Please use a color specifier or instance, not a string", obj);
1960 }
1961 else
1962 {
1963 invalid_argument ("Don't know how to convert to GdkColor", obj);
1964 }
1965 }
1966 else if (arg->type == GTK_TYPE_GDK_FONT)
1967 {
1968 if (SYMBOLP (obj))
1969 {
1970 /* If it is a symbol, we treat that as a face name */
1971 obj = Ffind_face (obj);
1972 }
1973
1974 if (FACEP (obj))
1975 {
1976 /* If it is a face, we just grab the font specifier, and
1977 cascade down until we finally reach a FONT_INSTANCE
1978 */
1979 obj = Fget (obj, Qfont, Qnil);
1980 }
1981
1982 if (FONT_SPECIFIERP (obj))
1983 {
1984 /* If it is a specifier, we just convert it to an
1985 instance, and let the ifs below handle it
1986 */
1987 obj = Fspecifier_instance (obj, Qnil, Qnil, Qnil);
1988 }
1989
1990 if (FONT_INSTANCEP (obj))
1991 {
1992 /* Easiest one */
1993 *(GTK_RETLOC_BOXED(*arg)) = FONT_INSTANCE_GTK_FONT (XFONT_INSTANCE (obj));
1994 }
1995 else if (STRINGP (obj))
1996 {
1997 invalid_argument ("Please use a font specifier or instance, not a string", obj);
1998 }
1999 else
2000 {
2001 invalid_argument ("Don't know how to convert to GdkColor", obj);
2002 }
2003 }
2004 else
2005 {
2006 /* Unknown type to convert to boxed */
2007 stderr_out ("Don't know how to convert to boxed!\n");
2008 *(GTK_RETLOC_BOXED(*arg)) = NULL;
2009 }
2010 break;
2011
2012 case GTK_TYPE_POINTER:
2013 if (NILP (obj))
2014 *(GTK_RETLOC_POINTER(*arg)) = NULL;
2015 else
2016 *(GTK_RETLOC_POINTER(*arg)) = LISP_TO_VOID (obj);
2017 break;
2018
2019 /* structured types */
2020 case GTK_TYPE_SIGNAL:
2021 case GTK_TYPE_ARGS: /* This we can do as a list of values */
2022 case GTK_TYPE_C_CALLBACK:
2023 case GTK_TYPE_FOREIGN:
2024 stderr_out ("Do not know how to convert `%s' from lisp!\n", gtk_type_name (arg->type));
2025 return (-1);
2026
2027 #if 0
2028 /* #### BILL! */
2029 /* This is not used, and does not work with union type */
2030 case GTK_TYPE_CALLBACK:
2031 {
2032 GUI_ID id;
2033
2034 id = new_gui_id ();
2035 obj = Fcons (Qnil, obj); /* Empty data */
2036 obj = Fcons (make_int (id), obj);
2037
2038 gcpro_popup_callbacks (id, obj);
2039
2040 *(GTK_RETLOC_CALLBACK(*arg)).marshal = __internal_callback_marshal;
2041 *(GTK_RETLOC_CALLBACK(*arg)).data = (gpointer) obj;
2042 *(GTK_RETLOC_CALLBACK(*arg)).notify = __internal_callback_destroy;
2043 }
2044 break;
2045 #endif
2046
2047 /* base type of the object system */
2048 case GTK_TYPE_OBJECT:
2049 if (NILP (obj))
2050 *(GTK_RETLOC_OBJECT (*arg)) = NULL;
2051 else
2052 {
2053 CHECK_GTK_OBJECT (obj);
2054 if (XGTK_OBJECT (obj)->alive_p)
2055 *(GTK_RETLOC_OBJECT (*arg)) = XGTK_OBJECT (obj)->object;
2056 else
2057 invalid_argument ("Attempting to pass dead object to GTK function", obj);
2058 }
2059 break;
2060
2061 default:
2062 if (GTK_FUNDAMENTAL_TYPE (arg->type) == GTK_TYPE_ARRAY)
2063 {
2064 if (NILP (obj))
2065 *(GTK_RETLOC_POINTER(*arg)) = NULL;
2066 else
2067 {
2068 xemacs_list_to_array (obj, arg);
2069 }
2070 }
2071 else if (GTK_FUNDAMENTAL_TYPE (arg->type) == GTK_TYPE_LISTOF)
2072 {
2073 if (NILP (obj))
2074 *(GTK_RETLOC_POINTER(*arg)) = NULL;
2075 else
2076 {
2077 xemacs_list_to_gtklist (obj, arg);
2078 }
2079 }
2080 else
2081 {
2082 stderr_out ("Do not know how to convert `%s' from lisp!\n", gtk_type_name (arg->type));
2083 abort();
2084 }
2085 break;
2086 }
2087
2088 return (0);
2089 }
2090
1810 /* This is used in glyphs-gtk.c as well */ 2091 /* This is used in glyphs-gtk.c as well */
1811 static Lisp_Object 2092 static Lisp_Object
1812 get_enumeration (GtkType t) 2093 get_enumeration (GtkType t)
1813 { 2094 {
1814 Lisp_Object alist; 2095 Lisp_Object alist;