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