| 
									
										
										
										
											2008-08-27 20:27:06 -04:00
										 |  |  | USING: accessors sequences assocs kernel quotations namespaces | 
					
						
							| 
									
										
										
										
											2009-02-12 21:42:32 -05:00
										 |  |  | xml.data xml.traversal combinators macros parser lexer words fry | 
					
						
							|  |  |  | regexp ;
 | 
					
						
							| 
									
										
										
										
											2007-11-28 23:34:11 -05:00
										 |  |  | IN: xmode.utilities | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-12-15 21:31:55 -05:00
										 |  |  | : implies ( x y -- z ) [ not ] dip or ; inline
 | 
					
						
							| 
									
										
										
										
											2007-11-28 23:34:11 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | : tag-init-form ( spec -- quot )
 | 
					
						
							|  |  |  |     { | 
					
						
							| 
									
										
										
										
											2008-04-26 00:17:08 -04:00
										 |  |  |         { [ dup quotation? ] [ [ object get tag get ] prepose ] } | 
					
						
							| 
									
										
										
										
											2007-11-28 23:34:11 -05:00
										 |  |  |         { [ dup length 2 = ] [ | 
					
						
							| 
									
										
										
										
											2008-12-02 01:25:23 -05:00
										 |  |  |             first2 '[ | 
					
						
							|  |  |  |                 tag get children>string | 
					
						
							|  |  |  |                 _ [ execute ] when* object get _ execute
 | 
					
						
							|  |  |  |             ] | 
					
						
							| 
									
										
										
										
											2007-11-28 23:34:11 -05:00
										 |  |  |         ] } | 
					
						
							|  |  |  |         { [ dup length 3 = ] [ | 
					
						
							| 
									
										
										
										
											2008-12-02 01:25:23 -05:00
										 |  |  |             first3 '[ | 
					
						
							| 
									
										
										
										
											2009-01-28 18:18:14 -05:00
										 |  |  |                 tag get _ attr | 
					
						
							| 
									
										
										
										
											2008-12-02 01:25:23 -05:00
										 |  |  |                 _ [ execute ] when* object get _ execute
 | 
					
						
							|  |  |  |             ] | 
					
						
							| 
									
										
										
										
											2007-11-28 23:34:11 -05:00
										 |  |  |         ] } | 
					
						
							|  |  |  |     } cond ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : with-tag-initializer ( tag obj quot -- )
 | 
					
						
							| 
									
										
										
										
											2008-04-26 00:17:08 -04:00
										 |  |  |     [ object set tag set ] prepose with-scope ; inline
 | 
					
						
							| 
									
										
										
										
											2007-11-28 23:34:11 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | MACRO: (init-from-tag) ( specs -- )
 | 
					
						
							|  |  |  |     [ tag-init-form ] map concat [ ] like
 | 
					
						
							|  |  |  |     [ with-tag-initializer ] curry ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : init-from-tag ( tag tuple specs -- tuple )
 | 
					
						
							| 
									
										
										
										
											2008-12-02 01:25:23 -05:00
										 |  |  |     over [ (init-from-tag) ] dip ; inline
 | 
					
						
							| 
									
										
										
										
											2009-02-12 21:42:32 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | : <?insensitive-regexp> ( string ? -- regexp )
 | 
					
						
							|  |  |  |     "i" "" ? <optioned-regexp> ;
 |