test.scm added by matijja on Mon Feb 4 18:24:58 2019

(require-extension bind)
(import (chicken process-context)
	(chicken foreign)
	(chicken memory))

(bind* "
typedef enum
{
  GTK_WINDOW_TOPLEVEL,
  GTK_WINDOW_POPUP
} GtkWindowType;

void gtk_init(int*, char***);
void* gtk_window_new(GtkWindowType);
void gtk_widget_show(void*);
void gtk_main();

unsigned long g_signal_connect_data(void* instance,
				    char* detailed_signal,
				    void* c_handler,
				    void* data,
				    void* destroy_data,
				    int   connect_flags);

")

(define-external (on_quit (c-pointer widget) (c-pointer data))
  void
  (display 'quit)
  (newline))

(let* ((argv (cons (program-name) (command-line-arguments)))
       (argc (length argv)))
  (gtk_init (object->pointer argc) (object->pointer argv)))

(let ((window (gtk_window_new GTK_WINDOW_TOPLEVEL)))
  (gtk_widget_show window)
  (g_signal_connect_data window "destroy" (foreign-safe-lambda void on_quit c-pointer c-pointer) #f #f 0)
  ((foreign-safe-lambda void gtk_main)))

;;; Compiled with: csc test.scm -C "`pkg-config --cflags gtk+-3.0`"  -L "`pkg-config --libs gtk+-3.0`"
;;; Output:
;;; 
;; Error: segmentation violation
;; 
;; 	Call history:
;; 
;; 	test.scm:1: chicken.load#load-extension	  
;; 	test.scm:32: chicken.process-context#program-name	  
;; 	test.scm:32: chicken.process-context#command-line-arguments	  
;; 	test.scm:34: chicken.memory#object->pointer	  
;; 	test.scm:34: chicken.memory#object->pointer	  
;; 	test.scm:34: gtk_init	  
;; 	test.scm:36: gtk_window_new	  
;; 	test.scm:37: gtk_widget_show	  
;; 	test.scm:38: g_signal_connect_data	  
;; 	test.scm:6: ##sys#make-c-string	  
;; 	test.scm:38: ##sys#gc	  
;; 	test.scm:39: g137	  	<--