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 vocabs.loader splitting
   7 accessors debugger help.topics ;
   8 IN: editors
   9
  10 TUPLE: no-edit-hook ;
  11
  12 M: no-edit-hook summary
  13     drop "You must load one of the below vocabularies before using editor integration:" ;
  14
  15 SYMBOL: edit-hook
  16
  17 : available-editors ( -- seq )
  18     "editors" all-child-vocabs-seq [ vocab-name ] map ;
  19
  20 : editor-restarts ( -- alist )
  21     available-editors
  22     [ [ "Load " prepend ] keep ] { } map>assoc ;
  23
  24 : no-edit-hook ( -- )
  25     \ no-edit-hook new
  26     editor-restarts throw-restarts
  27     require ;
  28
  29 : edit-location ( file line -- )
  30     [ (normalize-path) ] dip edit-hook get-global
  31     [ call( file line -- ) ] [ no-edit-hook edit-location ] if* ;
  32
  33 ERROR: cannot-find-source definition ;
  34
  35 M: cannot-find-source error.
  36     "Cannot find source for ``" write
  37     definition>> pprint-short
  38     "''" print ;
  39
  40 : edit ( defspec -- )
  41     dup where
  42     [ first2 edit-location ]
  43     [ dup word-link? [ name>> edit ] [ cannot-find-source ] if ]
  44     ?if ;
  45
  46 : edit-vocab ( name -- )
  47     >vocab-link edit ;
  48
  49 GENERIC: error-file ( error -- file )
  50
  51 GENERIC: error-line ( error -- line )
  52
  53 M: lexer-error error-file
  54     error>> error-file ;
  55
  56 M: lexer-error error-line
  57     [ error>> error-line ] [ line>> ] bi or ;
  58
  59 M: source-file-error error-file
  60     [ error>> error-file ] [ file>> ] bi or ;
  61
  62 M: source-file-error error-line
  63     error>> error-line ;
  64
  65 M: condition error-file
  66     error>> error-file ;
  67
  68 M: condition error-line
  69     error>> error-line ;
  70
  71 M: object error-file
  72     drop f ;
  73
  74 M: object error-line
  75     drop f ;
  76
  77 : (:edit) ( error -- )
  78     [ error-file ] [ error-line ] bi
  79     2dup and [ edit-location ] [ 2drop ] if ;
  80
  81 : :edit ( -- )
  82     error get (:edit) ;
  83
  84 : edit-error ( error -- )
  85     [ file>> ] [ line#>> ] bi 2dup and [ edit-location ] [ 2drop ] if ;
  86
  87 : edit-each ( seq -- )
  88     [
  89         [ "Editing " write . ]
  90         [
  91             "RETURN moves on to the next usage, C+d stops." print
  92             flush
  93             edit
  94             readln
  95         ] bi
  96     ] all? drop ;
  97
  98 : fix ( word -- )
  99     [ "Fixing " write pprint " and all usages..." print nl ]
 100     [ [ smart-usage ] keep prefix ] bi
 101     edit-each ;