From 9641cb5e70c39b1103bf2d432039302b1e711fa2 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@mflatt-laptop.(none)>
Date: Thu, 3 Nov 2011 16:33:28 -0600
Subject: [PATCH] add #:fail argument to `with-gl-context' in `canvas%'

original commit: 0f6c26779876beaaa5463a4f478aa569af79db28
---
 collects/mred/private/mrcanvas.rkt          | 14 +++++++++++---
 collects/scribblings/gui/canvas-class.scrbl | 17 +++++++++++------
 2 files changed, 22 insertions(+), 9 deletions(-)

diff --git a/collects/mred/private/mrcanvas.rkt b/collects/mred/private/mrcanvas.rkt
index 2e43a6de..56a0a26a 100644
--- a/collects/mred/private/mrcanvas.rkt
+++ b/collects/mred/private/mrcanvas.rkt
@@ -117,9 +117,17 @@
 	  (check-label-string/false cwho label)))
       (public
         [on-scroll (lambda (e) (send wx do-on-scroll e))]
-	[swap-gl-buffers (lambda () (send (send (send wx get-dc) get-gl-context) swap-buffers))]
-	[with-gl-context (lambda (thunk) 
-			   (send (send (send wx get-dc) get-gl-context) call-as-current thunk))]
+	[swap-gl-buffers (lambda () 
+                           (let ([ctx (send (send wx get-dc) get-gl-context)])
+                             (when ctx
+                               (send ctx swap-buffers))))]
+	[with-gl-context (lambda (thunk #:fail [fail (lambda () 
+                                                       (error (who->name '(method canvas% with-gl-context))
+                                                              "no gl context available"))])
+			   (let ([ctx (send (send wx get-dc) get-gl-context)])
+			     (if ctx
+				 (send ctx call-as-current thunk)
+				 (fail))))]
 	[accept-tab-focus (entry-point
 			   (case-lambda
 			    [() (send wx get-tab-focus)]
diff --git a/collects/scribblings/gui/canvas-class.scrbl b/collects/scribblings/gui/canvas-class.scrbl
index 790c26b1..1af63abe 100644
--- a/collects/scribblings/gui/canvas-class.scrbl
+++ b/collects/scribblings/gui/canvas-class.scrbl
@@ -415,27 +415,32 @@ for this canvas's DC as returned by
 @method[canvas<%> get-dc].
 
 The 
-@method[gl-context<%> swap-buffers]
+@xmethod[gl-context<%> swap-buffers]
 method acquires a re-entrant lock, so nested calls to
-@method[canvas% with-gl-context] on different threads or OpenGL contexts can block or deadlock.
+@method[canvas% swap-gl-buffers] or @method[canvas% with-gl-context]
+on different threads or OpenGL contexts can block or deadlock.
 
 
 }
 
 
-@defmethod[(with-gl-context [thunk (-> any)])
+@defmethod[(with-gl-context [thunk (-> any)]
+			    [#:fail fail (-> any) (lambda () (error ....))])
            any]{
 Passes the given thunk to
 @method[gl-context<%> call-as-current]
 of the result of 
 @method[dc<%> get-gl-context]
 for this canvas's DC as returned by
-@method[canvas<%> get-dc].
+@method[canvas<%> get-dc]. If @method[dc<%> get-gl-context]
+returns @racket[#f], then @racket[fail] is called,
+instead.
 
 The 
-@method[gl-context<%> call-as-current]
+@xmethod[gl-context<%> call-as-current]
 method acquires a re-entrant lock, so nested calls to
-@method[canvas% with-gl-context] on different threads or OpenGL contexts can block or deadlock.
+@method[canvas% with-gl-context] or @method[canvas% swap-gl-buffers]
+on different threads or OpenGL contexts can block or deadlock.
 
 
 }