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