1 /* I really wish this entire file could go away, but there is
2 currently no way to do the following in the Foreign Function
5 1) Deal with return values in the parameter list (ie: int *foo)
7 So we have to code a few functions by hand. Ick.
9 William M. Perry 5/8/00
14 DEFUN ("gtk-box-query-child-packing", Fgtk_box_query_child_packing, 2, 2,0, /*
15 Returns information about how CHILD is packed into BOX.
16 Return value is a list of (EXPAND FILL PADDING PACK_TYPE).
20 gboolean expand, fill;
22 GtkPackType pack_type;
23 Lisp_Object result = Qnil;
25 CHECK_GTK_OBJECT (box);
26 CHECK_GTK_OBJECT (child);
28 if (!GTK_IS_BOX (XGTK_OBJECT (box)->object))
30 signal_simple_error ("Object is not a GtkBox", box);
33 if (!GTK_IS_WIDGET (XGTK_OBJECT (child)->object))
35 signal_simple_error ("Child is not a GtkWidget", child);
38 gtk_box_query_child_packing (GTK_BOX (XGTK_OBJECT (box)->object),
39 GTK_WIDGET (XGTK_OBJECT (child)->object),
40 &expand, &fill, &padding, &pack_type);
42 result = Fcons (make_int (pack_type), result);
43 result = Fcons (make_int (padding), result);
44 result = Fcons (fill ? Qt : Qnil, result);
45 result = Fcons (expand ? Qt : Qnil, result);
50 /* void gtk_button_box_get_child_size_default (gint *min_width, gint *min_height); */
51 DEFUN ("gtk-button-box-get-child-size-default",
52 Fgtk_button_box_get_child_size_default, 0, 0, 0, /*
53 Return a cons cell (WIDTH . HEIGHT) of the default button box child size.
59 gtk_button_box_get_child_size_default (&width, &height);
61 return (Fcons (make_int (width), make_int (height)));
64 /* void gtk_button_box_get_child_ipadding_default (gint *ipad_x, gint *ipad_y); */
65 DEFUN ("gtk-button-box-get-child-ipadding-default",
66 Fgtk_button_box_get_child_ipadding_default, 0, 0, 0, /*
67 Return a cons cell (X . Y) of the default button box ipadding.
73 gtk_button_box_get_child_ipadding_default (&x, &y);
75 return (Fcons (make_int (x), make_int (y)));
78 /* void gtk_button_box_get_child_size (GtkButtonBox *widget,
79 gint *min_width, gint *min_height); */
80 DEFUN ("gtk-button-box-get-child-size", Fgtk_button_box_get_child_size, 1, 1, 0, /*
81 Get the current size of a child in the buttonbox BOX.
87 CHECK_GTK_OBJECT (box);
89 if (!GTK_IS_BUTTON_BOX (XGTK_OBJECT (box)->object))
91 signal_simple_error ("Not a GtkBox object", box);
94 gtk_button_box_get_child_size (GTK_BUTTON_BOX (XGTK_OBJECT (box)->object),
97 return (Fcons (make_int (width), make_int (height)));
100 /* void gtk_button_box_get_child_ipadding (GtkButtonBox *widget, gint *ipad_x, gint *ipad_y); */
101 DEFUN ("gtk-button-box-get-child-ipadding",
102 Fgtk_button_box_get_child_ipadding, 1, 1, 0, /*
103 Return a cons cell (X . Y) of the current buttonbox BOX ipadding.
109 CHECK_GTK_OBJECT (box);
111 if (!GTK_IS_BUTTON_BOX (XGTK_OBJECT (box)->object))
113 signal_simple_error ("Not a GtkBox object", box);
116 gtk_button_box_get_child_ipadding (GTK_BUTTON_BOX (XGTK_OBJECT (box)->object),
119 return (Fcons (make_int (x), make_int (y)));
122 /*void gtk_calendar_get_date (GtkCalendar *calendar,
127 DEFUN ("gtk-calendar-get-date", Fgtk_calendar_get_date, 1, 1, 0, /*
128 Return a list of (YEAR MONTH DAY) from the CALENDAR object.
132 guint year, month, day;
134 CHECK_GTK_OBJECT (calendar);
136 if (!GTK_IS_CALENDAR (XGTK_OBJECT (calendar)->object))
138 signal_simple_error ("Not a GtkCalendar object", calendar);
141 gtk_calendar_get_date (GTK_CALENDAR (XGTK_OBJECT (calendar)->object),
142 &year, &month, &day);
144 return (list3 (make_int (year), make_int (month), make_int (day)));
147 /* gint gtk_clist_get_text (GtkCList *clist,
152 DEFUN ("gtk-clist-get-text", Fgtk_clist_get_text, 3, 3, 0, /*
153 Returns the text from GtkCList OBJ cell at coordinates ROW, COLUMN.
158 Lisp_Object rval = Qnil;
160 CHECK_GTK_OBJECT (obj);
164 if (!GTK_IS_CLIST (XGTK_OBJECT (obj)->object))
166 signal_simple_error ("Object is not a GtkCList", obj);
169 gtk_clist_get_text (GTK_CLIST (XGTK_OBJECT (obj)->object), XINT (row), XINT (column), &text);
173 rval = build_string (text);
174 /* NOTE: This is NOT a memory leak. GtkCList returns a pointer
175 to internally used memory, not a copy of it.
183 /* gint gtk_clist_get_selection_info (GtkCList *clist,
188 DEFUN ("gtk-clist-get-selection-info", Fgtk_clist_get_selection, 3, 3, 0, /*
189 Returns a cons cell of (ROW . COLUMN) of the GtkCList OBJ at coordinates X, Y.
195 CHECK_GTK_OBJECT (obj);
199 if (!GTK_IS_CLIST (XGTK_OBJECT (obj)->object))
201 signal_simple_error ("Object is not a GtkCList", obj);
204 gtk_clist_get_selection_info (GTK_CLIST (XGTK_OBJECT (obj)->object),
205 XINT (x), XINT (y), &row, &column);
207 return (Fcons (make_int (row), make_int (column)));
210 DEFUN ("gtk-clist-get-pixmap", Fgtk_clist_get_pixmap, 3, 3, 0, /*
211 Return a cons of (pixmap . mask) at ROW,COLUMN in CLIST.
213 (clist, row, column))
215 GdkPixmap *pixmap = NULL;
216 GdkBitmap *mask = NULL;
218 CHECK_GTK_OBJECT (clist);
222 if (!GTK_IS_CLIST (XGTK_OBJECT (clist)->object))
224 signal_simple_error ("Object is not a GtkCList", clist);
227 gtk_clist_get_pixmap (GTK_CLIST (XGTK_OBJECT (clist)->object),
228 XINT (row), XINT (column),
231 return (Fcons (pixmap ? build_gtk_boxed (pixmap, GTK_TYPE_GDK_WINDOW) : Qnil,
232 mask ? build_gtk_boxed (mask, GTK_TYPE_GDK_WINDOW) : Qnil));
235 DEFUN ("gtk-clist-get-pixtext", Fgtk_clist_get_pixtext, 3, 3, 0, /*
236 Return a list of (pixmap mask text) at ROW,COLUMN in CLIST.
238 (clist, row, column))
240 GdkPixmap *pixmap = NULL;
241 GdkBitmap *mask = NULL;
245 CHECK_GTK_OBJECT (clist);
249 if (!GTK_IS_CLIST (XGTK_OBJECT (clist)->object))
251 signal_simple_error ("Object is not a GtkCList", clist);
254 gtk_clist_get_pixtext (GTK_CLIST (XGTK_OBJECT (clist)->object),
255 XINT (row), XINT (column), &text, &spacing,
258 return (list3 (pixmap ? build_gtk_boxed (pixmap, GTK_TYPE_GDK_WINDOW) : Qnil,
259 mask ? build_gtk_boxed (mask, GTK_TYPE_GDK_WINDOW) : Qnil,
260 (text && text[0]) ? build_string (text) : Qnil));
263 /* void gtk_color_selection_get_color(GtkColorSelection *colorsel, gdouble *color); */
264 DEFUN ("gtk-color-selection-get-color", Fgtk_color_selection_get_color, 1, 1, 0, /*
265 Return a list of (RED GREEN BLUE ALPHA) from the GtkColorSelection OBJECT.
271 CHECK_GTK_OBJECT (object);
273 if (!GTK_IS_COLOR_SELECTION (XGTK_OBJECT (object)->object))
275 signal_simple_error ("Object is not a GtkColorSelection", object);
278 gtk_color_selection_get_color (GTK_COLOR_SELECTION (XGTK_OBJECT (object)), rgba);
280 return (list4 (make_float (rgba[0]),
281 make_float (rgba[1]),
282 make_float (rgba[2]),
283 make_float (rgba[3])));
286 /* (gtk-import-function nil "gtk_editable_insert_text" 'GtkEditable 'GtkString 'gint 'pointer-to-gint) */
287 DEFUN ("gtk-editable-insert-text", Fgtk_editable_insert_text, 3, 3, 0, /*
288 Insert text STRINT at POS in GtkEditable widget OBJ.
289 Returns the new position of the cursor in the widget.
295 CHECK_GTK_OBJECT (obj);
296 CHECK_STRING (string);
299 the_pos = XINT (pos);
301 if (!GTK_IS_EDITABLE (XGTK_OBJECT (obj)->object))
303 signal_simple_error ("Object is not a GtkEditable", obj);
306 gtk_editable_insert_text (GTK_EDITABLE (XGTK_OBJECT (obj)->object),
307 (char *) XSTRING_DATA (string),
308 XSTRING_LENGTH (string),
311 return (make_int (the_pos));
314 DEFUN ("gtk-pixmap-get", Fgtk_pixmap_get, 1, 1, 0, /*
315 Return a cons cell of (PIXMAP . MASK) from GtkPixmap OBJECT.
319 GdkPixmap *pixmap, *mask;
321 CHECK_GTK_OBJECT (object);
323 if (!GTK_IS_PIXMAP (XGTK_OBJECT (object)->object))
325 signal_simple_error ("Object is not a GtkPixmap", object);
328 gtk_pixmap_get (GTK_PIXMAP (XGTK_OBJECT (object)->object), &pixmap, &mask);
330 return (Fcons (pixmap ? build_gtk_object (GTK_OBJECT (pixmap)) : Qnil,
331 mask ? build_gtk_object (GTK_OBJECT (mask)) : Qnil));
334 DEFUN ("gtk-curve-get-vector", Fgtk_curve_get_vector, 2, 2, 0, /*
335 Returns a vector of LENGTH points representing the curve of CURVE.
339 gfloat *vector = NULL;
340 Lisp_Object lisp_vector = Qnil;
343 CHECK_GTK_OBJECT (curve);
346 if (!GTK_IS_CURVE (XGTK_OBJECT (curve)->object))
348 signal_simple_error ("Object is not a GtkCurve", curve);
351 vector = (gfloat *) alloca (sizeof (gfloat) * XINT (length));
353 gtk_curve_get_vector (GTK_CURVE (XGTK_OBJECT (curve)->object), XINT (length), vector);
354 lisp_vector = make_vector (XINT (length), Qnil);
356 for (i = 0; i < XINT (length); i++)
358 XVECTOR_DATA (lisp_vector)[i] = make_float (vector[i]);
361 return (lisp_vector);
364 DEFUN ("gtk-curve-set-vector", Fgtk_curve_set_vector, 2, 2, 0, /*
365 Set the vector of points on CURVE to VECTOR.
369 gfloat *c_vector = NULL;
373 CHECK_GTK_OBJECT (curve);
374 CHECK_VECTOR (vector);
376 vec_length = XVECTOR_LENGTH (vector);
378 if (!GTK_IS_CURVE (XGTK_OBJECT (curve)->object))
380 signal_simple_error ("Object is not a GtkCurve", curve);
383 c_vector = (gfloat *) alloca (sizeof (gfloat) * vec_length);
385 for (i = 0; i < vec_length; i++)
387 CHECK_FLOAT (XVECTOR_DATA (vector)[i]);
388 c_vector[i] = extract_float (XVECTOR_DATA (vector)[i]);
391 gtk_curve_set_vector (GTK_CURVE (XGTK_OBJECT (curve)->object), vec_length, c_vector);
395 DEFUN ("gtk-label-get", Fgtk_label_get, 1, 1, 0, /*
396 Return the text of LABEL.
402 CHECK_GTK_OBJECT (label);
404 if (!GTK_IS_LABEL (XGTK_OBJECT (label)->object))
406 signal_simple_error ("Object is not a GtkLabel", label);
409 gtk_label_get (GTK_LABEL (XGTK_OBJECT (label)->object), &string);
411 return (build_string (string));
414 DEFUN ("gtk-notebook-query-tab-label-packing", Fgtk_notebook_query_tab_label_packing, 2, 2, 0, /*
415 Return a list of packing information (EXPAND FILL PACK_TYPE) for CHILD in NOTEBOOK.
419 gboolean expand, fill;
420 GtkPackType pack_type;
422 CHECK_GTK_OBJECT (notebook);
423 CHECK_GTK_OBJECT (child);
425 if (!GTK_IS_NOTEBOOK (XGTK_OBJECT (notebook)->object))
427 signal_simple_error ("Object is not a GtkLabel", notebook);
430 if (!GTK_IS_WIDGET (XGTK_OBJECT (child)->object))
432 signal_simple_error ("Object is not a GtkWidget", child);
435 gtk_notebook_query_tab_label_packing (GTK_NOTEBOOK (XGTK_OBJECT (notebook)->object),
436 GTK_WIDGET (XGTK_OBJECT (child)->object),
437 &expand, &fill, &pack_type);
439 return (list3 (expand ? Qt : Qnil, fill ? Qt : Qnil, make_int (pack_type)));
442 DEFUN ("gtk-widget-get-pointer", Fgtk_widget_get_pointer, 1, 1, 0, /*
443 Return the pointer position relative to WIDGET as a cons of (X . Y).
448 CHECK_GTK_OBJECT (widget);
450 if (!GTK_IS_WIDGET (XGTK_OBJECT (widget)->object))
452 signal_simple_error ("Object is not a GtkWidget", widget);
455 gtk_widget_get_pointer (GTK_WIDGET (XGTK_OBJECT (widget)->object), &x, &y);
457 return (Fcons (make_int (x), make_int (y)));
460 /* This is called whenever an item with a GUI_ID associated with it is
461 destroyed. This allows us to remove the references in gui-gtk.c
462 that made sure callbacks and such were GCPRO-ed
465 __remove_gcpro_by_id (gpointer user_data)
467 ungcpro_popup_callbacks ((GUI_ID) user_data);
471 __generic_toolbar_callback (GtkWidget *item, gpointer user_data)
473 Lisp_Object callback;
474 Lisp_Object lisp_user_data;
476 VOID_TO_LISP (callback, user_data);
478 lisp_user_data = XCAR (callback);
479 callback = XCDR (callback);
481 signal_special_gtk_user_event (Qnil, callback, lisp_user_data);
485 generic_toolbar_insert_item (Lisp_Object toolbar,
487 Lisp_Object tooltip_text,
488 Lisp_Object tooltip_private_text,
490 Lisp_Object callback,
492 Lisp_Object prepend_p,
493 Lisp_Object position)
498 CHECK_GTK_OBJECT (toolbar);
499 CHECK_GTK_OBJECT (icon);
501 CHECK_STRING (tooltip_text);
502 CHECK_STRING (tooltip_private_text);
504 if (!SYMBOLP (callback) && !LISTP (callback))
506 signal_simple_error ("Callback must be symbol or eval-able form", callback);
509 if (!GTK_IS_TOOLBAR (XGTK_OBJECT (toolbar)->object))
511 signal_simple_error ("Object is not a GtkToolbar", toolbar);
514 if (!GTK_IS_WIDGET (XGTK_OBJECT (icon)->object))
516 signal_simple_error ("Object is not a GtkWidget", icon);
519 callback = Fcons (data, callback);
522 gcpro_popup_callbacks (id, callback);
523 gtk_object_weakref (XGTK_OBJECT (toolbar)->object, __remove_gcpro_by_id,
528 w = (NILP (prepend_p) ? gtk_toolbar_append_item : gtk_toolbar_prepend_item)
529 (GTK_TOOLBAR (XGTK_OBJECT (toolbar)->object),
531 XSTRING_DATA (tooltip_text),
532 XSTRING_DATA (tooltip_private_text),
533 GTK_WIDGET (XGTK_OBJECT (icon)->object),
534 GTK_SIGNAL_FUNC (__generic_toolbar_callback),
535 LISP_TO_VOID (callback));
539 w = gtk_toolbar_insert_item (GTK_TOOLBAR (XGTK_OBJECT (toolbar)->object),
541 XSTRING_DATA (tooltip_text),
542 XSTRING_DATA (tooltip_private_text),
543 GTK_WIDGET (XGTK_OBJECT (icon)->object),
544 GTK_SIGNAL_FUNC (__generic_toolbar_callback),
545 LISP_TO_VOID (callback),
550 return (w ? build_gtk_object (GTK_OBJECT (w)) : Qnil);
553 DEFUN ("gtk-toolbar-append-item", Fgtk_toolbar_append_item, 6, 7, 0, /*
554 Appends a new button to the given toolbar.
556 (toolbar, text, tooltip_text, tooltip_private_text, icon, callback, data))
558 return (generic_toolbar_insert_item (toolbar,text,tooltip_text,tooltip_private_text,icon,callback,data,Qnil,Qnil));
561 DEFUN ("gtk-toolbar-prepend-item", Fgtk_toolbar_prepend_item, 6, 7, 0, /*
562 Adds a new button to the beginning (left or top edges) of the given toolbar.
564 (toolbar, text, tooltip_text, tooltip_private_text, icon, callback, data))
566 return (generic_toolbar_insert_item (toolbar,text,tooltip_text,tooltip_private_text,icon,callback,data,Qt,Qnil));
569 DEFUN ("gtk-toolbar-insert-item", Fgtk_toolbar_insert_item, 7, 8, 0, /*
570 Adds a new button to the beginning (left or top edges) of the given toolbar.
572 (toolbar, text, tooltip_text, tooltip_private_text, icon, callback, position, data))
574 CHECK_INT (position);
576 return (generic_toolbar_insert_item (toolbar,text,tooltip_text,tooltip_private_text,icon,callback,data,Qnil,position));
579 /* GtkCTree is an abomination in the eyes of the object system. */
581 __emacs_gtk_ctree_recurse_internal (GtkCTree *ctree, GtkCTreeNode *node, gpointer user_data)
585 VOID_TO_LISP (closure, user_data);
587 call3 (XCAR (closure),
588 build_gtk_object (GTK_OBJECT (ctree)),
589 build_gtk_boxed (node, GTK_TYPE_CTREE_NODE),
593 DEFUN ("gtk-ctree-recurse", Fgtk_ctree_recurse, 3, 6, 0, /*
594 Recursively apply FUNC to all nodes of CTREE at or below NODE.
595 FUNC is called with three arguments: CTREE, a GtkCTreeNode, and DATA.
596 The return value of FUNC is ignored.
598 If optional 5th argument CHILDFIRSTP is non-nil, then
599 the function is called for each node after it has been
600 called for that node's children.
602 Optional 6th argument DEPTH limits how deeply to recurse.
604 This function encompasses all the following Gtk functions:
606 void gtk_ctree_post_recursive (GtkCTree *ctree,
610 void gtk_ctree_post_recursive_to_depth (GtkCTree *ctree,
615 void gtk_ctree_pre_recursive (GtkCTree *ctree,
619 void gtk_ctree_pre_recursive_to_depth (GtkCTree *ctree,
625 (ctree, node, func, data, childfirstp, depth))
627 struct gcpro gcpro1, gcpro2, gcpro3;
628 Lisp_Object closure = Qnil;
630 CHECK_GTK_OBJECT (ctree);
634 CHECK_GTK_BOXED (node);
642 closure = Fcons (func, data);
644 GCPRO3 (ctree, node, closure);
648 (NILP (childfirstp) ? gtk_ctree_post_recursive : gtk_ctree_pre_recursive)
649 (GTK_CTREE (XGTK_OBJECT (ctree)->object),
650 NILP (node) ? NULL : (GtkCTreeNode *) XGTK_BOXED (node)->object,
651 __emacs_gtk_ctree_recurse_internal,
652 LISP_TO_VOID (closure));
656 (NILP (childfirstp) ? gtk_ctree_post_recursive_to_depth : gtk_ctree_pre_recursive_to_depth)
657 (GTK_CTREE (XGTK_OBJECT (ctree)->object),
658 NILP (node) ? NULL : (GtkCTreeNode *) XGTK_BOXED (node)->object,
660 __emacs_gtk_ctree_recurse_internal,
661 LISP_TO_VOID (closure));
668 void syms_of_ui_byhand (void)
670 DEFSUBR (Fgtk_toolbar_append_item);
671 DEFSUBR (Fgtk_toolbar_insert_item);
672 DEFSUBR (Fgtk_toolbar_prepend_item);
673 DEFSUBR (Fgtk_box_query_child_packing);
674 DEFSUBR (Fgtk_button_box_get_child_size_default);
675 DEFSUBR (Fgtk_button_box_get_child_ipadding_default);
676 DEFSUBR (Fgtk_button_box_get_child_size);
677 DEFSUBR (Fgtk_button_box_get_child_ipadding);
678 DEFSUBR (Fgtk_calendar_get_date);
679 DEFSUBR (Fgtk_clist_get_text);
680 DEFSUBR (Fgtk_clist_get_selection);
681 DEFSUBR (Fgtk_clist_get_pixmap);
682 DEFSUBR (Fgtk_clist_get_pixtext);
683 DEFSUBR (Fgtk_color_selection_get_color);
684 DEFSUBR (Fgtk_editable_insert_text);
685 DEFSUBR (Fgtk_pixmap_get);
686 DEFSUBR (Fgtk_curve_get_vector);
687 DEFSUBR (Fgtk_curve_set_vector);
688 DEFSUBR (Fgtk_label_get);
689 DEFSUBR (Fgtk_notebook_query_tab_label_packing);
690 DEFSUBR (Fgtk_widget_get_pointer);
691 DEFSUBR (Fgtk_ctree_recurse);