path: root/src/Gtk/Internal.icl

implementation module Gtk.Internal

import StdEnv
import StdMaybe

import System._Pointer

import code from "clean_gtk_support."

g_object_unref :: !Pointer !.a -> .a
g_object_unref p env = code {
	ccall g_object_unref "p:V:A"
}

g_signal_connect_void :: !Pointer !String !Int !.a -> .a
g_signal_connect_void widget signal id env = connect widget (packString signal) id env
where
	connect :: !Pointer !String !Int !.a -> .a
	connect _ _ _ _ = code {
		ccall clean_g_signal_connect_void "psI:V:A"
	}

g_signal_pop :: !.a -> (!Maybe GSignalArgs, !.a)
g_signal_pop env
	# (sig,env) = pop env
	| sig == 0
		= (Nothing, env)
	# (id,sig) = readIntP sig (IF_INT_64_OR_32 8 4)
	| sig == 0 // force evaluation
		= abort "Internal error in g_signal_pop\n"
		= (Just {sig_id=id}, env)
where
	pop :: !.a -> (!Pointer, !.a)
	pop env = code {
		ccall clean_g_signal_pop ":p:A"
	}

gtk_box_new :: !Bool !Int !.a -> (!Pointer, !.a)
gtk_box_new vertical spacing env = code {
	ccall gtk_box_new "II:p:A"
}

gtk_box_pack_start :: !Pointer !Pointer !Bool !Bool !Int !.a -> .a
gtk_box_pack_start box child expand fill spacing env = code {
	ccall gtk_box_pack_start "ppIII:V:A"
}

gtk_box_pack_end :: !Pointer !Pointer !Bool !Bool !Int !.a -> .a
gtk_box_pack_end box child expand fill spacing env = code {
	ccall gtk_box_pack_end "ppIII:V:A"
}

gtk_container_add :: !Pointer !Pointer !.a -> .a
gtk_container_add container widget env = code {
	ccall gtk_container_add "pp:V:A"
}

gtk_css_provider_new :: !.a -> (!Pointer, !.a)
gtk_css_provider_new env = code {
	ccall gtk_css_provider_new ":p:A"
}

// TODO: this relies on a deprecated return value; we should connect to the
// parsing-error signal instead.
gtk_css_provider_load_from_path :: !Pointer !String !Pointer !.a -> (!Bool, !.a)
gtk_css_provider_load_from_path provider path error env = load provider (packString path) error env
where
	load :: !Pointer !String !Pointer !.a -> (!Bool, !.a)
	load _ _ _ _ = code {
		ccall gtk_css_provider_load_from_path "psp:I:A"
	}

gtk_frame_new :: !(Maybe String) !.a -> (!Pointer, !.a)
gtk_frame_new Nothing env = new 0 env
where
	new :: !Int !.a -> (!Pointer, !.a)
	new _ _ = code {
		ccall gtk_frame_new "p:p:A"
	}
gtk_frame_new (Just label) env = new label env
where
	new :: !String !.a -> (!Pointer, !.a)
	new _ _ = code {
		ccall gtk_frame_new "s:p:A"
	}

gtk_frame_set_label_align :: !Pointer !Real !Real !.a -> .a
gtk_frame_set_label_align frame xalign yalign env = code {
	ccall gtk_frame_set_label_align "prr:V:A"
}

gtk_init :: !.a -> .a
gtk_init env = init 0 0 env
where
	init :: !Pointer !Pointer !.a -> .a
	init argc argv env = code {
		ccall gtk_init "pp:V:A"
	}

gtk_main_iteration :: !.a -> (!Bool, !.a)
gtk_main_iteration env = code {
	ccall gtk_main_iteration ":I:A"
}

gtk_main_quit :: !.a -> .a
gtk_main_quit env = code {
	ccall gtk_main_quit ":V:A"
}

gtk_menu_bar_new :: !.a -> (!Pointer, !.a)
gtk_menu_bar_new env = code {
	ccall gtk_menu_bar_new ":p:A"
}

gtk_menu_item_new :: !.a -> (!Pointer, !.a)
gtk_menu_item_new env = code {
	ccall gtk_menu_item_new ":p:A"
}

gtk_menu_item_set_label :: !Pointer !String !.a -> .a
gtk_menu_item_set_label item label env = set item (packString label) env
where
	set :: !Pointer !String !.a -> .a
	set _ _ _ = code {
		ccall gtk_menu_item_set_label "ps:V:A"
	}

gtk_menu_item_set_use_underline :: !Pointer !Bool !.a -> .a
gtk_menu_item_set_use_underline item setting env = code {
	ccall gtk_menu_item_set_use_underline "pI:V:A"
}

gtk_menu_item_set_submenu :: !Pointer !Pointer !.a -> .a
gtk_menu_item_set_submenu item menu env = code {
	ccall gtk_menu_item_set_submenu "pp:V:A"
}

gtk_menu_new :: !.a -> (!Pointer, !.a)
gtk_menu_new env = code {
	ccall gtk_menu_new ":p:A"
}

gtk_menu_shell_append :: !Pointer !Pointer !.a -> .a
gtk_menu_shell_append shell item env = code {
	ccall gtk_menu_shell_append "pp:V:A"
}

gtk_paned_new :: !Bool !.a -> (!Pointer, !.a)
gtk_paned_new vertical env = code {
	ccall gtk_paned_new "I:p:A"
}

gtk_paned_pack1 :: !Pointer !Pointer !Bool !Bool !.a -> .a
gtk_paned_pack1 paned child resize shrink env = code {
	ccall gtk_paned_pack1 "ppII:V:A"
}

gtk_paned_pack2 :: !Pointer !Pointer !Bool !Bool !.a -> .a
gtk_paned_pack2 paned child resize shrink env = code {
	ccall gtk_paned_pack2 "ppII:V:A"
}

gtk_paned_set_wide_handle :: !Pointer !Bool !.a -> .a
gtk_paned_set_wide_handle paned setting env = code {
	ccall gtk_paned_set_wide_handle "pI:V:A"
}

gtk_scrolled_window_new :: !Pointer !Pointer !.a -> (!Pointer, !.a)
gtk_scrolled_window_new hadjust vadjust env = code {
	ccall gtk_scrolled_window_new "pp:p:A"
}

gtk_style_context_add_class :: !Pointer !String !.a -> .a
gtk_style_context_add_class context cls env = add context (packString cls) env
where
	add :: !Pointer !String !.a -> .a
	add _ _ _ = code {
		ccall gtk_style_context_add_class "ps:V:A"
	}

gtk_style_context_add_provider :: !Pointer !Pointer !Int !.a -> .a
gtk_style_context_add_provider context provider priority env = code {
	ccall gtk_style_context_add_provider "ppI:V:A"
}

gtk_style_context_add_provider_for_screen :: !Pointer !Pointer !Int !.a -> .a
gtk_style_context_add_provider_for_screen context provider priority env = code {
	ccall gtk_style_context_add_provider_for_screen "ppI:V:A"
}

gtk_style_context_remove_class :: !Pointer !String !.a -> .a
gtk_style_context_remove_class context cls env = remove context (packString cls) env
where
	remove :: !Pointer !String !.a -> .a
	remove _ _ _ = code {
		ccall gtk_style_context_remove_class "ps:V:A"
	}

gtk_text_buffer_insert_at_cursor :: !Pointer !String !Int !.a -> .a
gtk_text_buffer_insert_at_cursor buffer string len env = code {
	ccall gtk_text_buffer_insert_at_cursor "psI:V:A"
}

gtk_text_view_new :: !.a -> (!Pointer, !.a)
gtk_text_view_new env = code {
	ccall gtk_text_view_new ":p:A"
}

gtk_text_view_get_buffer :: !Pointer -> Pointer
gtk_text_view_get_buffer text_view = code {
	ccall gtk_text_view_get_buffer "p:p"
}

gtk_text_view_set_editable :: !Pointer !Bool !.a -> .a
gtk_text_view_set_editable text_view setting env = code {
	ccall gtk_text_view_set_editable "pI:V:A"
}

gtk_widget_get_screen :: !Pointer !.a -> (!Pointer, !.a)
gtk_widget_get_screen widget env = code {
	ccall gtk_widget_get_screen "p:p:A"
}

gtk_widget_get_style_context :: !Pointer !.a -> (!Pointer, !.a)
gtk_widget_get_style_context widget env = code {
	ccall gtk_widget_get_style_context "p:p:A"
}

gtk_widget_set_margin_bottom :: !Pointer !Int !.a -> .a
gtk_widget_set_margin_bottom widget padding env = code {
	ccall gtk_widget_set_margin_bottom "pI:V:A"
}

gtk_widget_set_margin_left :: !Pointer !Int !.a -> .a
gtk_widget_set_margin_left widget padding env = code {
	ccall gtk_widget_set_margin_left "pI:V:A"
}

gtk_widget_set_margin_right :: !Pointer !Int !.a -> .a
gtk_widget_set_margin_right widget padding env = code {
	ccall gtk_widget_set_margin_right "pI:V:A"
}

gtk_widget_set_margin_top :: !Pointer !Int !.a -> .a
gtk_widget_set_margin_top widget padding env = code {
	ccall gtk_widget_set_margin_top "pI:V:A"
}

gtk_widget_set_size_request :: !Pointer !Int !Int !.a -> .a
gtk_widget_set_size_request widget hsize vsize env = code {
	ccall gtk_widget_set_size_request "pII:V:A"
}

gtk_widget_show :: !Pointer !.a -> .a
gtk_widget_show widget env = code {
	ccall gtk_widget_show "p:V:A"
}

gtk_window_new :: !Bool !.a -> (!Pointer, !.a)
gtk_window_new is_popup env = code {
	ccall gtk_window_new "I:p:A"
}

gtk_window_set_title :: !Pointer !String !.a -> .a
gtk_window_set_title window title env = set window (packString title) env
where
	set :: !Pointer !String !.a -> .a
	set _ _ _ = code {
		ccall gtk_window_set_title "ps:V:A"
	}