2009-01-31 21:44:17 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2004, 2009 Chris Double, Daniel Ehrenberg,
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Slava Pestov.
							 | 
						
					
						
							
								
									
										
										
										
											2009-01-30 20:28:16 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							
								
									
										
										
										
											2016-03-11 11:16:18 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								USING: accessors kernel xml.data xml.writer xml.syntax 
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								urls.encoding ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-01-30 20:28:16 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: html
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2016-03-11 11:16:18 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								TUPLE: empty-prolog < prolog ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: empty-prolog write-xml drop ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: <empty-prolog> ( -- prolog ) \ empty-prolog new ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-01-31 21:44:17 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: simple-page ( title head body -- xml )
							 | 
						
					
						
							
								
									
										
										
										
											2009-01-30 20:28:16 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    <XML
							 | 
						
					
						
							
								
									
										
										
										
											2016-03-11 11:16:18 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        <!DOCTYPE html>
							 | 
						
					
						
							
								
									
										
										
										
											2009-01-30 20:28:16 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            <head>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								                <title><-></title>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								                <->
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            </head>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            <body><-></body>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        </html>
							 | 
						
					
						
							
								
									
										
										
										
											2016-03-11 11:16:18 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    XML> <empty-prolog> >>prolog ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-01-31 21:44:17 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: render-error ( message -- xml )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [XML <span class="error"><-></span> XML] ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-01-30 20:28:16 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-01-31 21:44:17 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: simple-link ( xml url -- xml' )
							 | 
						
					
						
							
								
									
										
										
										
											2009-02-05 22:17:03 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    url-encode swap [XML <a href=<->><-></a> XML] ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-09-22 09:06:56 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: simple-image ( url -- xml )
							 | 
						
					
						
							
								
									
										
										
										
											2015-06-29 19:43:15 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    url-encode [XML <img src=<-> /> XML] ;
							 |