basis/editors/editors.factor

   1 ! Copyright (C) 2005, 2009 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs calendar classes.parser
   4 classes.singleton combinators.smart continuations debugger
   5 definitions io io.launcher io.pathnames kernel lexer namespaces
   6 parser.notes prettyprint sequences sets source-files.errors
   7 splitting strings threads tools.crossref tools.scaffold vocabs
   8 vocabs.files vocabs.hierarchy vocabs.loader vocabs.metadata
   9 vocabs.parser words ;
  10 IN: editors
  11
  12 SYMBOL: editor-class
  13
  14 : available-editors ( -- seq )
  15     "editors" disk-child-vocab-names
  16     { "editors.ui" "editors.private" } diff
  17     [ vocab-platforms supported-platform? ] filter ;
  18
  19 : editor-restarts ( -- alist )
  20     available-editors
  21     [ [ "Load " prepend ] keep ] { } map>assoc ;
  22
  23 : set-editor ( string -- )
  24     "editors." ?head drop
  25     [ "editors." prepend t parser-quiet? [ use-vocab ] with-variable ]
  26     [ search ] bi
  27     editor-class set-global ;
  28
  29 SYNTAX: EDITOR: scan-token set-editor ;
  30
  31 HOOK: editor-command editor-class ( file line -- command )
  32
  33 : write-pprint ( obj -- ) dup string? [ write ] [ pprint ] if ;
  34 : print-pprint ( obj -- ) dup string? [ print ] [ pprint nl ] if ;
  35
  36 : pprint-line ( seq -- )
  37     [
  38         dup string?
  39         [ print ]
  40         [ unclip-last [ [ write-pprint ] each ] [ print-pprint ] bi* ] if
  41     ] unless-empty ; inline
  42
  43 M: f editor-command
  44     "Select an editor" editor-restarts throw-restarts
  45     [ set-editor ]
  46     [
  47         "Note:" print
  48         '[
  49             "To make this editor permanent, in your "
  50             ".factor-boot-rc" home-path
  51             " or "
  52             ".factor-rc" home-path
  53             " add:\n"
  54             "USE: editors EDITOR: " _ append
  55         ] output>array pprint-line
  56     ] bi
  57     editor-command ;
  58
  59 HOOK: editor-detached? editor-class ( -- ? )
  60 M: object editor-detached? t ;
  61
  62 HOOK: editor-is-child? editor-class ( -- ? )
  63 M: object editor-is-child? f ;
  64
  65 : run-and-wait-for-editor ( command -- )
  66     <process>
  67         swap >>command
  68         editor-detached? >>detached
  69         editor-is-child? [ +new-group+ >>group ] unless
  70     run-process
  71     300 milliseconds sleep
  72     dup status>> { 0 f } member?
  73     [ drop ] [ process-failed ] if ;
  74
  75 ERROR: invalid-location file line ;
  76
  77 : edit-location ( file line -- )
  78     over [ invalid-location ] unless
  79     [ absolute-path ] dip
  80     editor-command [ run-and-wait-for-editor ] when* ;
  81
  82 ERROR: cannot-find-source definition ;
  83
  84 M: cannot-find-source error.
  85     "Cannot find source for ``" write
  86     definition>> pprint-short
  87     "''" print ;
  88
  89 : edit-file ( path -- )
  90     0 edit-location ;
  91
  92 DEFER: edit
  93
  94 <PRIVATE
  95
  96 : public-vocab-name ( vocab-spec -- name )
  97     vocab-name ".private" ?tail drop ;
  98
  99 PRIVATE>
 100
 101 : edit-vocab ( vocab -- )
 102     public-vocab-name >vocab-link edit ;
 103
 104 GENERIC: edit ( object -- )
 105
 106 M: object edit
 107     [ where ] [ first2 edit-location ] [ cannot-find-source ] ??if ;
 108
 109 M: string edit edit-vocab ;
 110
 111 : edit-error ( error -- )
 112     [ error-file ] [ error-line ] bi
 113     over [ 1 or edit-location ] [ 2drop ] if ;
 114
 115 : :edit ( -- )
 116     error get edit-error ;
 117
 118 : edit-each ( seq -- )
 119     [
 120         [ "Editing " write . ]
 121         [
 122             "RETURN moves on to the next usage, C+d stops." print
 123             flush
 124             edit
 125             readln
 126         ] bi
 127     ] all? drop ;
 128
 129 : fix ( word -- )
 130     [ "Fixing " write pprint " and all usages..." print nl ]
 131     [ [ smart-usage ] keep prefix ] bi
 132     edit-each ;
 133
 134 GENERIC: edit-docs ( object -- )
 135
 136 M: object edit-docs
 137     public-vocab-name vocab-docs-path 1 edit-location ;
 138
 139 M: word edit-docs
 140     dup "help-loc" word-prop
 141     [ nip first2 edit-location ]
 142     [ vocabulary>> edit-docs ]
 143     if* ;
 144
 145 GENERIC: edit-tests ( object -- )
 146
 147 M: object edit-tests
 148     public-vocab-name vocab-tests-path 1 edit-location ;
 149
 150 M: word edit-tests vocabulary>> edit-tests ;
 151
 152 : edit-platforms ( vocab -- )
 153     public-vocab-name vocab-platforms-path 1 edit-location ;
 154
 155 : edit-authors ( vocab -- )
 156     public-vocab-name vocab-authors-path 1 edit-location ;
 157
 158 : edit-tags ( vocab -- )
 159     public-vocab-name vocab-tags-path 1 edit-location ;
 160
 161 : edit-summary ( vocab -- )
 162     public-vocab-name vocab-summary-path 1 edit-location ;