<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml"><head><title>PLaneT Package Repository : Home ><body><div class="racketnav"><div class="navcontent"><table border="0" cellpadding="0" cellspacing="0" width="100%"><tr><td><span class="navtitle" style="font-size: 100px; vertical-align: middle;">(</span><span class="navtitle" style="font-size: 80px; vertical-align: middle;">(</span><span class="navtitle" style="font-size: 60px; vertical-align: middle;">(</span><span class="navtitle" style="font-size: 40px; vertical-align: middle;"> 
(<span class="keyword">require</span> <span class="variable">mzlib/match</span>)
(<span class="keyword">define-struct</span> <span class="variable">widget</span>
(<span class="variable">object</span> <span class="variable">id</span> <span class="variable">semaphore</span>))
(<span class="keyword">provide</span> <span class="variable">widget</span> <span class="variable">widget-object</span> <span class="variable">widget-id</span> <span class="variable">widget-semaphore</span>)
(<span class="keyword">define-syntax</span> <span class="variable">guiml-child</span>
(<span class="keyword">syntax-rules</span> (<span class="variable">@</span>)
((<span class="variable">_</span> (<span class="variable">parent-binding</span>)) <span class="builtin">null</span>)
((<span class="variable">_</span> (<span class="variable">parent-binding</span> (<span class="variable">head</span> <span class="variable">id</span> (<span class="variable">@</span> . <span class="variable">properties</span>) . <span class="variable">tl</span>) . <span class="variable">siblings</span>))
(<span class="builtin">cons</span>
(<span class="variable">guiml</span> (<span class="variable">head</span> <span class="variable">id</span> (<span class="variable">@</span> (<span class="variable">parent</span> <span class="variable">parent-binding</span>) . <span class="variable">properties</span>)
. <span class="variable">tl</span>))
(<span class="variable">guiml-child</span> (<span class="variable">parent-binding</span> . <span class="variable">siblings</span>))))
((<span class="variable">_</span> (<span class="variable">parent-binding</span> (<span class="variable">head</span> (<span class="variable">@</span> . <span class="variable">properties</span>) . <span class="variable">tl</span>) . <span class="variable">siblings</span>))
(<span class="builtin">cons</span>
(<span class="variable">guiml</span> (<span class="variable">head</span> (<span class="variable">@</span> (<span class="variable">parent</span> <span class="variable">parent-binding</span>) . <span class="variable">properties</span>) . <span class="variable">tl</span>))
(<span class="variable">guiml-child</span> (<span class="variable">parent-binding</span> . <span class="variable">siblings</span>))))
((<span class="variable">_</span> (<span class="variable">parent-binding</span> (<span class="variable">head</span> <span class="variable">id</span> . <span class="variable">tl</span>) . <span class="variable">siblings</span>))
(<span class="variable">guiml-child</span> (<span class="variable">parent-binding</span> (<span class="variable">head</span> <span class="variable">id</span> (<span class="variable">@</span>) . <span class="variable">tl</span>) . <span class="variable">siblings</span>)))
((<span class="variable">_</span> (<span class="variable">parent-binding</span> (<span class="variable">head</span> . <span class="variable">tl</span>) . <span class="variable">siblings</span>))
(<span class="variable">guiml-child</span> (<span class="variable">parent-binding</span> (<span class="variable">head</span> (<span class="variable">@</span>) . <span class="variable">tl</span>) . <span class="variable">siblings</span>)))))
(<span class="keyword">define-syntax</span> <span class="variable">guiml</span>
(<span class="keyword">syntax-rules</span> (<span class="variable">@</span>)
((<span class="variable">_</span> (<span class="variable">name</span> <span class="variable">id</span> (<span class="variable">@</span> . <span class="variable">properties</span>)))
(<span class="variable">make-widget</span> (<span class="variable">new</span> <span class="variable">name</span> . <span class="variable">properties</span>) <span class="variable">id</span> (<span class="builtin">make-semaphore</span> <span class="selfeval">1</span>)))
((<span class="variable">_</span> (<span class="variable">name</span> <span class="variable">id</span> (<span class="variable">@</span> . <span class="variable">properties</span>) <span class="variable">first-child</span> . <span class="variable">rest-children</span>))
(<span class="keyword">let</span> ((<span class="variable">top</span> (<span class="variable">new</span> <span class="variable">name</span> . <span class="variable">properties</span>)))
(<span class="builtin">cons</span> (<span class="variable">make-widget</span> <span class="variable">top</span> <span class="variable">id</span> (<span class="builtin">make-semaphore</span> <span class="selfeval">1</span>))
(<span class="variable">guiml-child</span> (<span class="variable">top</span> <span class="variable">first-child</span> . <span class="variable">rest-children</span>)))))
<span class="comment"></span> ((<span class="variable">_</span> (<span class="variable">name</span> (<span class="variable">@</span> . <span class="variable">properties</span>)))
(<span class="variable">guiml</span> (<span class="variable">name</span> <span class="selfeval">#f</span> (<span class="variable">@</span> . <span class="variable">properties</span>))))
<span class="comment"></span> <span class="comment"></span>
((<span class="variable">_</span> (<span class="variable">name</span> <span class="variable">id</span>)) (<span class="variable">make-widget</span> (<span class="variable">new</span> <span class="variable">name</span>) <span class="variable">id</span> (<span class="builtin">make-semaphore</span> <span class="selfeval">1</span>)))
((<span class="variable">_</span> (<span class="variable">name</span> . <span class="variable">rest</span>))
(<span class="variable">guiml</span> (<span class="variable">name</span> <span class="selfeval">#f</span> . <span class="variable">rest</span>)))))
(<span class="keyword">define-syntax</span> <span class="variable">sendmsg</span>
(<span class="keyword">syntax-rules</span> ()
((<span class="variable">_</span> <span class="variable">widget</span> <span class="variable">args</span> <span class="keyword">...</span>)
(<span class="variable">send</span> (<span class="variable">widget-object</span> (<span class="keyword">if</span> (<span class="builtin">pair?</span> <span class="variable">widget</span>)
(<span class="builtin">car</span> <span class="variable">widget</span>) <span class="variable">widget</span>)) <span class="variable">args</span> <span class="keyword">...</span>))))
(<span class="keyword">provide</span> <span class="variable">sendmsg</span>)
(<span class="keyword">define</span> (<span class="variable">recursive-find</span> <span class="variable">pred</span> <span class="variable">list-data</span>)
(<span class="variable">match</span> <span class="variable">list-data</span>
(() <span class="selfeval">#f</span>)
(((<span class="variable">?</span> <span class="variable">pred</span> <span class="variable">hd</span>) . <span class="variable">tl</span>) <span class="variable">hd</span>)
(((<span class="variable">?</span> <span class="builtin">pair?</span> <span class="variable">hd</span>) . <span class="variable">tl</span>)
(<span class="keyword">let</span> ((<span class="variable">verdict</span> (<span class="variable">recursive-find</span> <span class="variable">pred</span> <span class="variable">hd</span>)))
(<span class="keyword">if</span> <span class="variable">verdict</span>
<span class="variable">verdict</span>
(<span class="variable">recursive-find</span> <span class="variable">pred</span> <span class="variable">tl</span>))))
((<span class="variable">_</span> . <span class="variable">tl</span>) (<span class="variable">recursive-find</span> <span class="variable">pred</span> <span class="variable">tl</span>))
(<span class="variable">x</span> <span class="selfeval">#f</span>)))
(<span class="keyword">define</span> (<span class="variable">get-widget-by-id</span> <span class="variable">top-widget</span> <span class="variable">id</span> (<span class="variable">compare</span> <span class="builtin">eq?</span>))
(<span class="variable">recursive-find</span>
(<span class="keyword">lambda</span> (<span class="variable">widget</span>)
(<span class="keyword">and</span> (<span class="variable">widget?</span> <span class="variable">widget</span>)
(<span class="variable">compare</span> (<span class="variable">widget-id</span> <span class="variable">widget</span>) <span class="variable">id</span>)))
<span class="variable">top-widget</span>))
(<span class="keyword">provide</span> <span class="variable">get-widget-by-id</span>)
<span class="comment"></span><span class="comment"></span>(<span class="keyword">provide</span> <span class="variable">guiml-child</span>)
(<span class="keyword">provide</span> <span class="variable">guiml</span>)</pre></div></div></div></body></html>