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