basis/editors/editors.factor

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