Fixing editors for parse-error/condition changes

db4
Slava Pestov 2008-04-04 04:12:25 -05:00
parent 82fc8f18db
commit f669d2c9f1
1 changed files with 26 additions and 13 deletions

View File

@ -3,7 +3,7 @@
USING: parser kernel namespaces sequences definitions io.files USING: parser kernel namespaces sequences definitions io.files
inspector continuations tools.crossref tools.vocabs inspector continuations tools.crossref tools.vocabs
io prettyprint source-files assocs vocabs vocabs.loader io prettyprint source-files assocs vocabs vocabs.loader
io.backend splitting classes.tuple ; io.backend splitting accessors ;
IN: editors IN: editors
TUPLE: no-edit-hook ; TUPLE: no-edit-hook ;
@ -18,7 +18,7 @@ SYMBOL: edit-hook
: editor-restarts ( -- alist ) : editor-restarts ( -- alist )
available-editors available-editors
[ "Load " over append swap ] { } map>assoc ; [ [ "Load " prepend ] keep ] { } map>assoc ;
: no-edit-hook ( -- ) : no-edit-hook ( -- )
\ no-edit-hook construct-empty \ no-edit-hook construct-empty
@ -26,7 +26,7 @@ SYMBOL: edit-hook
require ; require ;
: edit-location ( file line -- ) : edit-location ( file line -- )
>r (normalize-path) "\\\\?\\" ?head drop r> >r (normalize-path) r>
edit-hook get [ call ] [ no-edit-hook edit-location ] if* ; edit-hook get [ call ] [ no-edit-hook edit-location ] if* ;
: edit ( defspec -- ) : edit ( defspec -- )
@ -35,18 +35,31 @@ SYMBOL: edit-hook
: edit-vocab ( name -- ) : edit-vocab ( name -- )
vocab-source-path 1 edit-location ; vocab-source-path 1 edit-location ;
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 ;
: :edit ( -- ) : :edit ( -- )
error get delegates [ parse-error? ] find-last nip [ error get find-parse-error [
dup parse-error-file source-file-path [ file>> path>> ] [ line>> ] bi edit-location
swap parse-error-line edit-location
] when* ; ] when* ;
: fix ( word -- ) : fix ( word -- )
"Fixing " write dup pprint " and all usages..." print nl [ "Fixing " write pprint " and all usages..." print nl ]
dup usage swap prefix [ [ [ usage ] keep prefix ] bi
"Editing " write dup . [
"RETURN moves on to the next usage, C+d stops." print [ "Editing " write . ]
flush [
edit "RETURN moves on to the next usage, C+d stops." print
readln flush
edit
readln
] bi
] all? drop ; ] all? drop ;