basis/editors/editors.factor

   1 ! Copyright (C) 2005, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: parser lexer kernel namespaces sequences definitions
   4 io.files io.backend io.pathnames io summary continuations
   5 tools.crossref vocabs.hierarchy prettyprint source-files
   6 source-files.errors assocs vocabs.loader splitting
   7 accessors debugger help.topics ;
   8 FROM: vocabs => vocab-name >vocab-link ;
   9 IN: editors
  10
  11 TUPLE: no-edit-hook ;
  12
  13 M: no-edit-hook summary
  14     drop "You must load one of the below vocabularies before using editor integration:" ;
  15
  16 SYMBOL: edit-hook
  17
  18 : available-editors ( -- seq )
  19     "editors" child-vocabs no-roots no-prefixes [ vocab-name ] map ;
  20
  21 : editor-restarts ( -- alist )
  22     available-editors
  23     [ [ "Load " prepend ] keep ] { } map>assoc ;
  24
  25 : no-edit-hook ( -- )
  26     \ no-edit-hook new
  27     editor-restarts throw-restarts
  28     require ;
  29
  30 : edit-location ( file line -- )
  31     [ absolute-path ] dip edit-hook get-global
  32     [ call( file line -- ) ] [ no-edit-hook edit-location ] if* ;
  33
  34 ERROR: cannot-find-source definition ;
  35
  36 M: cannot-find-source error.
  37     "Cannot find source for ``" write
  38     definition>> pprint-short
  39     "''" print ;
  40
  41 : edit ( defspec -- )
  42     dup where
  43     [ first2 edit-location ]
  44     [ dup word-link? [ name>> edit ] [ cannot-find-source ] if ]
  45     ?if ;
  46
  47 : edit-vocab ( name -- )
  48     >vocab-link edit ;
  49
  50 : edit-error ( error -- )
  51     [ error-file ] [ error-line ] bi
  52     over [ 1 or edit-location ] [ 2drop ] if ;
  53
  54 : :edit ( -- )
  55     error get edit-error ;
  56
  57 : edit-each ( seq -- )
  58     [
  59         [ "Editing " write . ]
  60         [
  61             "RETURN moves on to the next usage, C+d stops." print
  62             flush
  63             edit
  64             readln
  65         ] bi
  66     ] all? drop ;
  67
  68 : fix ( word -- )
  69     [ "Fixing " write pprint " and all usages..." print nl ]
  70     [ [ smart-usage ] keep prefix ] bi
  71     edit-each ;