Mercurial > hg > xemacs-beta

comparison src/ui-gtk.c @ 5178:97eb4942aec8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Ben Wing <ben@xemacs.org>
date Mon, 29 Mar 2010 21:28:13 -0500
parents 8b2f75cecb89 1fae11d56ad2
children 71ee43b8a74d
comparison
equal deleted inserted replaced
5177:b785049378e3 5178:97eb4942aec8
2 ** 2 **
3 ** Description: Creating 'real' UIs from lisp. 3 ** Description: Creating 'real' UIs from lisp.
4 ** 4 **
5 ** Created by: William M. Perry <wmperry@gnu.org> 5 ** Created by: William M. Perry <wmperry@gnu.org>
6 ** Copyright (c) 2000 William M. Perry <wmperry@gnu.org> 6 ** Copyright (c) 2000 William M. Perry <wmperry@gnu.org>
7 ** Copyright (C) 2010 Ben Wing.
7 ** 8 **
8 ** This file is part of XEmacs. 9 ** This file is part of XEmacs.
9 ** 10 **
10 ** XEmacs is free software; you can redistribute it and/or modify it 11 ** XEmacs is free software; you can redistribute it and/or modify it
11 ** under the terms of the GNU General Public License as published by the 12 ** under the terms of the GNU General Public License as published by the
293 294
294 /* Foreign function calls */ 295 /* Foreign function calls */
295 static emacs_ffi_data * 296 static emacs_ffi_data *
296 allocate_ffi_data (void) 297 allocate_ffi_data (void)
297 { 298 {
298 emacs_ffi_data *data = ALLOC_LCRECORD_TYPE (emacs_ffi_data, &lrecord_emacs_ffi); 299 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (emacs_ffi);
300 emacs_ffi_data *data = XFFI (obj);
299 301
300 data->return_type = GTK_TYPE_NONE; 302 data->return_type = GTK_TYPE_NONE;
301 data->n_args = 0; 303 data->n_args = 0;
302 data->function_name = Qnil; 304 data->function_name = Qnil;
303 data->function_ptr = 0; 305 data->function_ptr = 0;
323 static void 325 static void
324 ffi_object_printer (Lisp_Object obj, Lisp_Object printcharfun, 326 ffi_object_printer (Lisp_Object obj, Lisp_Object printcharfun,
325 int UNUSED (escapeflag)) 327 int UNUSED (escapeflag))
326 { 328 {
327 if (print_readably) 329 if (print_readably)
328 printing_unreadable_lcrecord (obj, 0); 330 printing_unreadable_lisp_object (obj, 0);
329 331
330 write_fmt_string_lisp (printcharfun, "#<ffi %S", 1, XFFI (obj)->function_name); 332 write_fmt_string_lisp (printcharfun, "#<ffi %S", 1, XFFI (obj)->function_name);
331 if (XFFI (obj)->n_args) 333 if (XFFI (obj)->n_args)
332 write_fmt_string (printcharfun, " %d arguments", XFFI (obj)->n_args); 334 write_fmt_string (printcharfun, " %d arguments", XFFI (obj)->n_args);
333 write_fmt_string (printcharfun, " %p>", (void *)XFFI (obj)->function_ptr); 335 write_fmt_string (printcharfun, " %p>", (void *)XFFI (obj)->function_ptr);
334 } 336 }
335 337
336 DEFINE_LRECORD_IMPLEMENTATION ("ffi", emacs_ffi, 338 DEFINE_NODUMP_LISP_OBJECT ("ffi", emacs_ffi,
337 0, /*dumpable-flag*/ 339 mark_ffi_data, ffi_object_printer,
338 mark_ffi_data, ffi_object_printer, 340 0, 0, 0,
339 0, 0, 0, 341 ffi_data_description, emacs_ffi_data);
340 ffi_data_description, emacs_ffi_data);
341 342
342 #if defined (__cplusplus) 343 #if defined (__cplusplus)
343 #define MANY_ARGS ... 344 #define MANY_ARGS ...
344 #else 345 #else
345 #define MANY_ARGS 346 #define MANY_ARGS
793 static void 794 static void
794 emacs_gtk_object_printer (Lisp_Object obj, Lisp_Object printcharfun, 795 emacs_gtk_object_printer (Lisp_Object obj, Lisp_Object printcharfun,
795 int UNUSED (escapeflag)) 796 int UNUSED (escapeflag))
796 { 797 {
797 if (print_readably) 798 if (print_readably)
798 printing_unreadable_lcrecord (obj, 0); 799 printing_unreadable_lisp_object (obj, 0);
799 800
800 write_ascstring (printcharfun, "#<GtkObject ("); 801 write_ascstring (printcharfun, "#<GtkObject (");
801 if (XGTK_OBJECT (obj)->alive_p) 802 if (XGTK_OBJECT (obj)->alive_p)
802 write_cistring (printcharfun, gtk_type_name (GTK_OBJECT_TYPE (XGTK_OBJECT (obj)->object))); 803 write_cistring (printcharfun, gtk_type_name (GTK_OBJECT_TYPE (XGTK_OBJECT (obj)->object)));
803 else 804 else
804 write_ascstring (printcharfun, "dead"); 805 write_ascstring (printcharfun, "dead");
805 write_fmt_string (printcharfun, ") %p>", (void *) XGTK_OBJECT (obj)->object); 806 write_fmt_string (printcharfun, ") %p>", (void *) XGTK_OBJECT (obj)->object);
806 } 807 }
807 808
808 static Lisp_Object 809 static Lisp_Object
809 object_getprop (Lisp_Object obj, Lisp_Object prop) 810 emacs_gtk_object_getprop (Lisp_Object obj, Lisp_Object prop)
810 { 811 {
811 Lisp_Object rval = Qnil; 812 Lisp_Object rval = Qnil;
812 Lisp_Object prop_name = Qnil; 813 Lisp_Object prop_name = Qnil;
813 GtkArgInfo *info = NULL; 814 GtkArgInfo *info = NULL;
814 char *err; 815 char *err;
868 869
869 return (rval); 870 return (rval);
870 } 871 }
871 872
872 static int 873 static int
873 object_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value) 874 emacs_gtk_object_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
874 { 875 {
875 GtkArgInfo *info = NULL; 876 GtkArgInfo *info = NULL;
876 Lisp_Object prop_name = Qnil; 877 Lisp_Object prop_name = Qnil;
877 GtkArg args[2]; 878 GtkArg args[2];
878 char *err = NULL; 879 char *err = NULL;
921 { 922 {
922 return (XGTK_OBJECT (obj)->plist); 923 return (XGTK_OBJECT (obj)->plist);
923 } 924 }
924 925
925 static void 926 static void
926 emacs_gtk_object_finalizer (void *header, int for_disksave) 927 emacs_gtk_object_finalizer (Lisp_Object obj)
927 { 928 {
928 emacs_gtk_object_data *data = (emacs_gtk_object_data *) header; 929 emacs_gtk_object_data *data = XEMACS_GTK_OBJECT_DATA (obj);
929
930 if (for_disksave)
931 {
932 Lisp_Object obj = wrap_emacs_gtk_object (data);
933
934
935 invalid_operation
936 ("Can't dump an emacs containing GtkObject objects", obj);
937 }
938 930
939 if (data->alive_p) 931 if (data->alive_p)
940 { 932 gtk_object_unref (data->object);
941 gtk_object_unref (data->object); 933 }
942 } 934
943 } 935 DEFINE_NODUMP_LISP_OBJECT ("GtkObject", emacs_gtk_object,
944 936 mark_gtk_object_data,
945 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("GtkObject", emacs_gtk_object, 937 emacs_gtk_object_printer,
946 0, /*dumpable-flag*/ 938 emacs_gtk_object_finalizer,
947 mark_gtk_object_data, 939 0, /* equality */
948 emacs_gtk_object_printer, 940 0, /* hash */
949 emacs_gtk_object_finalizer, 941 gtk_object_data_description,
950 0, /* equality */ 942 emacs_gtk_object_data);
951 0, /* hash */
952 gtk_object_data_description,
953 object_getprop,
954 object_putprop,
955 0, /* rem prop */
956 0, /* plist */
957 emacs_gtk_object_data);
958 943
959 static emacs_gtk_object_data * 944 static emacs_gtk_object_data *
960 allocate_emacs_gtk_object_data (void) 945 allocate_emacs_gtk_object_data (void)
961 { 946 {
962 emacs_gtk_object_data *data = ALLOC_LCRECORD_TYPE (emacs_gtk_object_data, 947 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (emacs_gtk_object);
963 &lrecord_emacs_gtk_object); 948 emacs_gtk_object_data *data = XGTK_OBJECT (obj);
964 949
965 data->object = NULL; 950 data->object = NULL;
966 data->alive_p = FALSE; 951 data->alive_p = FALSE;
967 data->plist = Qnil; 952 data->plist = Qnil;
968 953
1112 static void 1097 static void
1113 emacs_gtk_boxed_printer (Lisp_Object obj, Lisp_Object printcharfun, 1098 emacs_gtk_boxed_printer (Lisp_Object obj, Lisp_Object printcharfun,
1114 int UNUSED (escapeflag)) 1099 int UNUSED (escapeflag))
1115 { 1100 {
1116 if (print_readably) 1101 if (print_readably)
1117 printing_unreadable_lcrecord (obj, 0); 1102 printing_unreadable_lisp_object (obj, 0);
1118 1103
1119 write_ascstring (printcharfun, "#<GtkBoxed ("); 1104 write_ascstring (printcharfun, "#<GtkBoxed (");
1120 write_cistring (printcharfun, gtk_type_name (XGTK_BOXED (obj)->object_type)); 1105 write_cistring (printcharfun, gtk_type_name (XGTK_BOXED (obj)->object_type));
1121 write_fmt_string (printcharfun, ") %p>", (void *) XGTK_BOXED (obj)->object); 1106 write_fmt_string (printcharfun, ") %p>", (void *) XGTK_BOXED (obj)->object);
1122 } 1107 }
1136 { 1121 {
1137 emacs_gtk_boxed_data *data = XGTK_BOXED(obj); 1122 emacs_gtk_boxed_data *data = XGTK_BOXED(obj);
1138 return (HASH2 ((Hashcode) data->object, data->object_type)); 1123 return (HASH2 ((Hashcode) data->object, data->object_type));
1139 } 1124 }
1140 1125
1141 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("GtkBoxed", emacs_gtk_boxed, 1126 DEFINE_NODUMP_LISP_OBJECT ("GtkBoxed", emacs_gtk_boxed,
1142 0, /*dumpable-flag*/ 1127 0, /* marker function */
1143 0, /* marker function */ 1128 emacs_gtk_boxed_printer,
1144 emacs_gtk_boxed_printer, 1129 0, /* nuker */
1145 0, /* nuker */ 1130 emacs_gtk_boxed_equality,
1146 emacs_gtk_boxed_equality, 1131 emacs_gtk_boxed_hash,
1147 emacs_gtk_boxed_hash, 1132 emacs_gtk_boxed_description,
1148 emacs_gtk_boxed_description, 1133 emacs_gtk_boxed_data);
1149 0, /* get prop */
1150 0, /* put prop */
1151 0, /* rem prop */
1152 0, /* plist */
1153 emacs_gtk_boxed_data);
1154 /* Currently defined GTK_TYPE_BOXED structures are: 1134 /* Currently defined GTK_TYPE_BOXED structures are:
1155 1135
1156 GtkAccelGroup - 1136 GtkAccelGroup -
1157 GtkSelectionData - 1137 GtkSelectionData -
1158 GtkStyle - 1138 GtkStyle -
1166 GdkColor - 1146 GdkColor -
1167 */ 1147 */
1168 static emacs_gtk_boxed_data * 1148 static emacs_gtk_boxed_data *
1169 allocate_emacs_gtk_boxed_data (void) 1149 allocate_emacs_gtk_boxed_data (void)
1170 { 1150 {
1171 emacs_gtk_boxed_data *data = ALLOC_LCRECORD_TYPE (emacs_gtk_boxed_data, 1151 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (emacs_gtk_boxed);
1172 &lrecord_emacs_gtk_boxed); 1152 emacs_gtk_boxed_data *data = XGTK_BOXED (obj);
1173 1153
1174 data->object = NULL; 1154 data->object = NULL;
1175 data->object_type = GTK_TYPE_INVALID; 1155 data->object_type = GTK_TYPE_INVALID;
1176 1156
1177 return (data); 1157 return (data);
1351 return (rval); 1331 return (rval);
1352 } 1332 }
1353 1333
1354 1334
1355 void 1335 void
1336 ui_gtk_objects_create (void)
1337 {
1338 OBJECT_HAS_METHOD (emacs_gtk_object, getprop);
1339 OBJECT_HAS_METHOD (emacs_gtk_object, putprop);
1340 /* #### No remprop or plist methods */
1341 }
1342
1343 void
1356 syms_of_ui_gtk (void) 1344 syms_of_ui_gtk (void)
1357 { 1345 {
1358 INIT_LRECORD_IMPLEMENTATION (emacs_ffi); 1346 INIT_LISP_OBJECT (emacs_ffi);
1359 INIT_LRECORD_IMPLEMENTATION (emacs_gtk_object); 1347 INIT_LISP_OBJECT (emacs_gtk_object);
1360 INIT_LRECORD_IMPLEMENTATION (emacs_gtk_boxed); 1348 INIT_LISP_OBJECT (emacs_gtk_boxed);
1361 DEFSYMBOL_MULTIWORD_PREDICATE (Qemacs_ffip); 1349 DEFSYMBOL_MULTIWORD_PREDICATE (Qemacs_ffip);
1362 DEFSYMBOL_MULTIWORD_PREDICATE (Qemacs_gtk_objectp); 1350 DEFSYMBOL_MULTIWORD_PREDICATE (Qemacs_gtk_objectp);
1363 DEFSYMBOL_MULTIWORD_PREDICATE (Qemacs_gtk_boxedp); 1351 DEFSYMBOL_MULTIWORD_PREDICATE (Qemacs_gtk_boxedp);
1364 DEFSYMBOL (Qvoid); 1352 DEFSYMBOL (Qvoid);
1365 DEFSUBR (Fdll_load); 1353 DEFSUBR (Fdll_load);