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