summaryrefslogtreecommitdiffstats
path: root/final_project/work/hello.scm
blob: d28154f42657d8d3e7060b122c3448fff495dcfc (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
(define (hello)
  (let ((window (gtk-window-new 'toplevel))
	(button (gtk-button-new))
	(label (gtk-label-new "Hello, World!")))
    (gtk-container-add button label)
    (gtk-container-add window button)
    (gtk-window-set-title window "Hello")
    (gtk-container-set-border-width button 10)
    (let ((counter 0))
      (g-signal-connect window (C-callback "delete_event")
	(lambda (w e)
	  (outf-console ";Delete me "(- 2 counter)" times.\n")
	  (set! counter (1+ counter))
	  ;; Three or more is the charm.
	  (if (> counter 2) 0 1)))
      (g-signal-connect button (C-callback "clicked")
	(lambda (w)
	  (if (= counter 1)
	      (begin
		(outf-console "\n;Erroring in "(current-thread)"...\n")
		(error "Testing error handling.")))
	  (let ((text (gtk-label-get-text label)))
	    (gtk-label-set-text
	     label (list->string (reverse! (string->list text)))))
	  unspecific)))
    (gtk-widget-show-all window)
    window))