| 
									
										
										
										
											2008-03-26 15:55:04 -04:00
										 |  |  | ! Copyright (C) 2005, 2008 Slava Pestov. | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							|  |  |  | USING: parser kernel namespaces sequences definitions io.files | 
					
						
							| 
									
										
										
										
											2008-03-29 04:34:48 -04:00
										 |  |  | inspector continuations tools.crossref tools.vocabs  | 
					
						
							| 
									
										
										
										
											2008-03-26 15:55:04 -04:00
										 |  |  | io prettyprint source-files assocs vocabs vocabs.loader | 
					
						
							| 
									
										
										
										
											2008-04-04 05:12:25 -04:00
										 |  |  | io.backend splitting accessors ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | IN: editors | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | TUPLE: no-edit-hook ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2007-11-25 04:33:46 -05:00
										 |  |  | M: no-edit-hook summary | 
					
						
							|  |  |  |     drop "You must load one of the below vocabularies before using editor integration:" ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | SYMBOL: edit-hook | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2007-11-25 04:33:46 -05:00
										 |  |  | : available-editors ( -- seq )
 | 
					
						
							| 
									
										
										
										
											2008-03-13 04:35:54 -04:00
										 |  |  |     "editors" all-child-vocabs-seq [ vocab-name ] map ;
 | 
					
						
							| 
									
										
										
										
											2007-11-25 04:33:46 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | : editor-restarts ( -- alist )
 | 
					
						
							|  |  |  |     available-editors | 
					
						
							| 
									
										
										
										
											2008-04-04 05:12:25 -04:00
										 |  |  |     [ [ "Load " prepend ] keep ] { } map>assoc ;
 | 
					
						
							| 
									
										
										
										
											2007-11-25 04:33:46 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | : no-edit-hook ( -- )
 | 
					
						
							| 
									
										
										
										
											2008-04-13 16:06:27 -04:00
										 |  |  |     \ no-edit-hook new
 | 
					
						
							| 
									
										
										
										
											2007-11-25 04:33:46 -05:00
										 |  |  |     editor-restarts throw-restarts
 | 
					
						
							|  |  |  |     require ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | : edit-location ( file line -- )
 | 
					
						
							| 
									
										
										
										
											2008-04-04 05:12:25 -04:00
										 |  |  |     >r (normalize-path) r> | 
					
						
							| 
									
										
										
										
											2008-03-27 19:00:55 -04:00
										 |  |  |     edit-hook get [ call ] [ no-edit-hook edit-location ] if* ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : edit ( defspec -- )
 | 
					
						
							|  |  |  |     where [ first2 edit-location ] when* ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-02-24 18:40:28 -05:00
										 |  |  | : edit-vocab ( name -- )
 | 
					
						
							|  |  |  |     vocab-source-path 1 edit-location ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-04-04 05:12:25 -04:00
										 |  |  | GENERIC: find-parse-error ( error -- error' )
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | M: parse-error find-parse-error | 
					
						
							|  |  |  |     dup error>> find-parse-error [ ] [ ] ?if ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | M: condition find-parse-error | 
					
						
							|  |  |  |     error>> find-parse-error ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | M: object find-parse-error | 
					
						
							|  |  |  |     drop f ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | : :edit ( -- )
 | 
					
						
							| 
									
										
										
										
											2008-04-04 05:12:25 -04:00
										 |  |  |     error get find-parse-error [ | 
					
						
							|  |  |  |         [ file>> path>> ] [ line>> ] bi edit-location | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  |     ] when* ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : fix ( word -- )
 | 
					
						
							| 
									
										
										
										
											2008-04-04 05:12:25 -04:00
										 |  |  |     [ "Fixing " write pprint " and all usages..." print nl ] | 
					
						
							|  |  |  |     [ [ usage ] keep prefix ] bi
 | 
					
						
							|  |  |  |     [ | 
					
						
							|  |  |  |         [ "Editing " write . ] | 
					
						
							|  |  |  |         [ | 
					
						
							|  |  |  |             "RETURN moves on to the next usage, C+d stops." print
 | 
					
						
							|  |  |  |             flush
 | 
					
						
							|  |  |  |             edit | 
					
						
							|  |  |  |             readln
 | 
					
						
							|  |  |  |         ] bi
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  |     ] all? drop ;
 |