basis/editors/editors.factor

   1 ! Copyright (C) 2005, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs continuations debugger definitions
   4 help.topics io io.backend io.files io.launcher io.pathnames
   5 kernel lexer math namespaces parser prettyprint sequences
   6 source-files source-files.errors splitting strings summary
   7 tools.crossref vocabs vocabs.files vocabs.hierarchy
   8 vocabs.loader vocabs.metadata calendar threads words ;
   9 FROM: vocabs => vocab-name >vocab-link ;
  10 IN: editors
  11
  12 SYMBOL: editor-class
  13
  14 : available-editors ( -- seq )
  15     "editors" loaded-child-vocab-names ;
  16
  17 : editor-restarts ( -- alist )
  18     available-editors
  19     [ [ "Load " prepend ] keep ] { } map>assoc ;
  20
  21 HOOK: editor-command editor-class ( file line -- command )
  22
  23 M: f editor-command
  24     "Select an editor" editor-restarts throw-restarts require
  25     editor-command ;
  26
  27 HOOK: editor-detached? editor-class ( -- ? )
  28 M: object editor-detached? t ;
  29
  30 : run-and-wait-for-editor ( command -- )
  31     <process>
  32         swap >>command
  33         editor-detached? >>detached
  34     run-process
  35     300 milliseconds sleep
  36     dup status>> { 0 f } member?
  37     [ drop ] [ process-failed ] if ;
  38
  39 ERROR: invalid-location file line ;
  40
  41 : edit-location ( file line -- )
  42     over [ invalid-location ] unless
  43     [ absolute-path ] dip
  44     editor-command [ run-and-wait-for-editor ] when* ;
  45
  46 ERROR: cannot-find-source definition ;
  47
  48 M: cannot-find-source error.
  49     "Cannot find source for ``" write
  50     definition>> pprint-short
  51     "''" print ;
  52
  53 : edit-file ( path -- )
  54     0 edit-location ;
  55
  56 DEFER: edit
  57
  58 : edit-vocab ( vocab -- )
  59     vocab-name* >vocab-link edit ;
  60
  61 GENERIC: edit ( object -- )
  62
  63 M: object edit
  64     dup where [ first2 edit-location ] [ cannot-find-source ] ?if ;
  65
  66 M: string edit edit-vocab ;
  67
  68 : edit-error ( error -- )
  69     [ error-file ] [ error-line ] bi
  70     over [ 1 or edit-location ] [ 2drop ] if ;
  71
  72 : :edit ( -- )
  73     error get edit-error ;
  74
  75 : edit-each ( seq -- )
  76     [
  77         [ "Editing " write . ]
  78         [
  79             "RETURN moves on to the next usage, C+d stops." print
  80             flush
  81             edit
  82             readln
  83         ] bi
  84     ] all? drop ;
  85
  86 : fix ( word -- )
  87     [ "Fixing " write pprint " and all usages..." print nl ]
  88     [ [ smart-usage ] keep prefix ] bi
  89     edit-each ;
  90
  91 GENERIC: edit-docs ( object -- )
  92
  93 M: object edit-docs
  94     vocab-name* vocab-docs-path 1 edit-location ;
  95
  96 M: word edit-docs
  97     dup "help-loc" word-prop
  98     [ nip first2 edit-location ]
  99     [ vocabulary>> edit-docs ]
 100     if* ;
 101
 102 GENERIC: edit-tests ( object -- )
 103
 104 M: object edit-tests
 105     vocab-name* vocab-tests-path 1 edit-location ;
 106
 107 M: word edit-tests vocabulary>> edit-tests ;
 108
 109 : edit-platforms ( vocab -- )
 110     dup vocab-platforms-path vocab-append-path 1 edit-location ;
 111
 112 : edit-authors ( vocab -- )
 113     dup vocab-authors-path vocab-append-path 1 edit-location ;
 114
 115 : edit-tags ( vocab -- )
 116     dup vocab-tags-path vocab-append-path 1 edit-location ;
 117
 118 : edit-summary ( vocab -- )
 119     dup vocab-summary-path vocab-append-path 1 edit-location ;