1;; This demo is pure crack. Don't do this. Glib allocates things on the
2;; stack sometimes, then points to them from the heap -- any stack
3;; manipulation that does not allow GLib to unwind the stack (for which
4;; GLib supplies no hooks) will cause undefined behaviour. It's
5;; surprising this works. --wingo.
6
7;; guile-gnome
8;; Copyright (C) 2000,2003,2004 Free Software Foundation, Inc.
9
10;; This program is free software; you can redistribute it and/or
11;; modify it under the terms of the GNU General Public License as
12;; published by the Free Software Foundation; either version 2 of
13;; the License, or (at your option) any later version.
14;;
15;; This program is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18;; GNU General Public License for more details.
19;;
20;; You should have received a copy of the GNU General Public License
21;; along with this program; if not, contact:
22;;
23;; Free Software Foundation           Voice:  +1-617-542-5942
24;; 59 Temple Place - Suite 330        Fax:    +1-617-542-2652
25;; Boston, MA  02111-1307,  USA       gnu@gnu.org
26
27
28;; This is an example of how to use continuations with the Gtk event
29;; loop.  It implements a dialog box that looks like to the programmer
30;; like it was modal, and to the user like it was non-modal.  The
31;; function `yes-or-no?' that implements this dialog box only returns
32;; to the caller when the user has aswered the dialog.  The user
33;; however can pop up any number of these dialog boxes and answer them
34;; in any order he likes.  The main application stays alive as well.
35
36(use-modules (oop goops) (gnome gtk))
37
38;; The callbacks that have been delayed
39
40(define callbacks '())
41
42;; Our own event-loop.  We remove the callbacks before invoking them
43;; so that we don't get confused when the callback reenters the
44;; event-loop.
45
46(define (event-loop)
47  (cond
48   ((not (null? callbacks))
49    (let ((c (car callbacks)))
50      (set! callbacks (cdr callbacks))
51	 (c #f)
52	 (event-loop)))
53   ((gtk-main-iteration)
54    (event-loop))))
55
56;; Connect to a signal and arrange for PROC to be consed onto
57;; CALLBACKS when the signal is emitted.
58
59(define (connect-delayed obj sig proc)
60  (connect obj sig (lambda (o) (set! callbacks (cons proc callbacks)))))
61
62;; Now for the continuation part.  To implement the non-modal dialog box
63;; that can be used from your code like a modal one, we save the
64;; continuation of the YES-OR-NO? invokation and reenter the event-loop
65;; (after popping up the window).  When a button has been clicked, we
66;; destroy the window and invoke the saved continuation with the
67;; appropriate return value.
68
69(define (yes-or-no? title)
70  (call-with-current-continuation
71   (lambda (cont)
72     ;; Now CONT is the part of the program that receives our
73     ;; return value.
74
75     (let* ((d (make <gtk-window> #:type 'toplevel))
76	    (v (make <gtk-vbox>))
77	    (h (make <gtk-hbox>))
78	    (l (make <gtk-label> #:label title))
79            (s (make <gtk-hseparator>))
80            (y (make <gtk-button> #:label "Yes"))
81            (n (make <gtk-button> #:label "No"))
82
83	    (answer (lambda (val)
84		      (destroy d)
85
86		      ;; Here we return to our caller after the
87		      ;; dialog has been destroyed.
88		      (cont val))))
89
90       (add d v)
91       (pack-start v l #f #f 0)
92       (pack-start v s #f #f 0)
93       (pack-start v h #f #f 0)
94       (pack-start h y #f #f 0)
95       (pack-start h n #f #f 0)
96       (show-all d)
97
98       ;; Bind ANSWER to the "clicked" signals of the action
99       ;; buttons.
100       (connect-delayed y 'clicked (lambda (y) (answer #t)))
101       (connect-delayed n 'clicked (lambda (n) (answer #f)))
102
103       ;; Reenter the event-loop.  You can think of this as a goto.
104       (event-loop)))))
105
106(define w (make <gtk-window> #:type 'toplevel))
107(define b (make <gtk-button> #:label "Ok!"))
108
109
110(set-default-size w 150 100)
111(add w b)
112
113(connect-delayed
114 b 'clicked
115 (let ((i 0))
116   (lambda (f)
117     (set! i (1+ i))
118     ;; capture I in a local environment so that nobody can alter
119     ;; it while YES-OR-NO? does its thing.
120     (let ((i i))
121       ;; Use YES-OR-NO? as if it were a modal dialog.
122       (pk i (yes-or-no? (string-append (number->string i)
123					": Really?")))))))
124
125(connect w 'destroy (lambda (w) (quit)))
126
127(show b)
128(show w)
129
130(event-loop)
131