Merge branch 'master' of git://factorcode.org/git/factor
Daniel Ehrenberg
commit
db0fee9e3c
|
|
@ -3,6 +3,9 @@ namespaces sequences system combinators
|
||||||
editors.vim vocabs.loader make ;
|
editors.vim vocabs.loader make ;
|
||||||
IN: editors.gvim
|
IN: editors.gvim
|
||||||
|
|
||||||
|
! This code builds on the code in editors.vim; see there for
|
||||||
|
! more information.
|
||||||
|
|
||||||
SINGLETON: gvim
|
SINGLETON: gvim
|
||||||
|
|
||||||
HOOK: gvim-path io-backend ( -- path )
|
HOOK: gvim-path io-backend ( -- path )
|
||||||
|
|
|
||||||
|
|
@ -4,7 +4,7 @@ IN: editors.vim.generate-syntax
|
||||||
|
|
||||||
: generate-vim-syntax ( -- )
|
: generate-vim-syntax ( -- )
|
||||||
"misc/factor.vim.fgen" resource-path <fhtml>
|
"misc/factor.vim.fgen" resource-path <fhtml>
|
||||||
"misc/factor.vim" resource-path
|
"misc/vim/syntax/factor.vim" resource-path
|
||||||
template-convert ;
|
template-convert ;
|
||||||
|
|
||||||
MAIN: generate-vim-syntax
|
MAIN: generate-vim-syntax
|
||||||
|
|
|
||||||
|
|
@ -12,5 +12,6 @@ $nl
|
||||||
"USE: vim"
|
"USE: vim"
|
||||||
"\"c:\\\\program files\\\\vim\\\\vim70\\\\gvim\" vim-path set-global"
|
"\"c:\\\\program files\\\\vim\\\\vim70\\\\gvim\" vim-path set-global"
|
||||||
}
|
}
|
||||||
"On Unix, you may omit the last line if " { $snippet "\"vim\"" } " is in your " { $snippet "$PATH" } "." ;
|
"On Unix, you may omit the last line if " { $snippet "\"vim\"" } " is in your " { $snippet "$PATH" } "."
|
||||||
|
$nl
|
||||||
|
"You may also wish to install Vim support files to enable syntax hilighting and other features. These are in the " { $link resource-path } " in " { $snippet "misc/vim" } "." ;
|
||||||
|
|
|
||||||
|
|
@ -20,11 +20,11 @@ HELP: <duplex-stream>
|
||||||
|
|
||||||
HELP: with-stream
|
HELP: with-stream
|
||||||
{ $values { "stream" duplex-stream } { "quot" quotation } }
|
{ $values { "stream" duplex-stream } { "quot" quotation } }
|
||||||
{ $description "Calls the quotation in a new dynamic scope, with both " { $link input-stream } " and " { $link output-stream } " rebound to " { $snippet "stream" } ". The stream is closed if the quotation returns or throws an error." } ;
|
{ $description "Calls the quotation in a new dynamic scope, with both " { $link input-stream } " and " { $link output-stream } " rebound to " { $snippet "stream" } ", which must be a duplex stream. The stream is closed if the quotation returns or throws an error." } ;
|
||||||
|
|
||||||
HELP: with-stream*
|
HELP: with-stream*
|
||||||
{ $values { "stream" duplex-stream } { "quot" quotation } }
|
{ $values { "stream" duplex-stream } { "quot" quotation } }
|
||||||
{ $description "Calls the quotation in a new dynamic scope, with both " { $link input-stream } " and " { $link output-stream } " rebound to " { $snippet "stream" } "." }
|
{ $description "Calls the quotation in a new dynamic scope, with both " { $link input-stream } " and " { $link output-stream } " rebound to " { $snippet "stream" } ", which must be a duplex stream." }
|
||||||
{ $notes "This word does not close the stream. Compare with " { $link with-stream } "." } ;
|
{ $notes "This word does not close the stream. Compare with " { $link with-stream } "." } ;
|
||||||
|
|
||||||
HELP: <encoder-duplex>
|
HELP: <encoder-duplex>
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,392 @@
|
||||||
|
|
||||||
|
USING: accessors calendar git-tool git-tool io.directories
|
||||||
|
io.monitors io.pathnames kernel locals math namespaces
|
||||||
|
sequences splitting system threads ui ui.gadgets
|
||||||
|
ui.gadgets.buttons ui.gadgets.labels ui.gadgets.packs ;
|
||||||
|
|
||||||
|
USING: git-tool ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
IN: git-tool.remote
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
TUPLE: <git-remote-gadget> < pack
|
||||||
|
repository
|
||||||
|
branch
|
||||||
|
remote
|
||||||
|
remote-branch
|
||||||
|
fetch-period
|
||||||
|
push
|
||||||
|
closed
|
||||||
|
last-refresh ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
: current-branch ( REPO -- branch )
|
||||||
|
{ "git" "branch" } git-process stdout>> [ "* " head? ] find nip 2 tail ;
|
||||||
|
|
||||||
|
: list-branches ( REPO -- branches )
|
||||||
|
{ "git" "branch" } git-process stdout>>
|
||||||
|
[ empty? not ] filter
|
||||||
|
[ 2 tail ] map ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
: list-remotes ( REPO -- remotes )
|
||||||
|
{ "git" "remote" } git-process stdout>> [ empty? not ] filter ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
:: list-remote-branches ( REPO REMOTE -- branches )
|
||||||
|
[let | OUT [ REPO { "git" "remote" "show" REMOTE } git-process stdout>> ] |
|
||||||
|
|
||||||
|
" Tracked remote branches" OUT member?
|
||||||
|
[
|
||||||
|
OUT
|
||||||
|
" Tracked remote branches" OUT index 1 + tail first " " split
|
||||||
|
[ empty? not ] filter
|
||||||
|
]
|
||||||
|
[
|
||||||
|
OUT
|
||||||
|
OUT [ " New remote branches" head? ] find drop
|
||||||
|
1 + tail first " " split
|
||||||
|
[ empty? not ] filter
|
||||||
|
]
|
||||||
|
if ] ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
:: refresh-git-remote-gadget ( GADGET -- )
|
||||||
|
|
||||||
|
[let | REPO [ GADGET repository>> ] |
|
||||||
|
|
||||||
|
GADGET clear-gadget
|
||||||
|
|
||||||
|
GADGET
|
||||||
|
|
||||||
|
! Repository label
|
||||||
|
|
||||||
|
"Repository: " REPO [ current-directory get ] with-directory append
|
||||||
|
<label>
|
||||||
|
add-gadget
|
||||||
|
|
||||||
|
! Branch button
|
||||||
|
|
||||||
|
<shelf>
|
||||||
|
|
||||||
|
"Branch: " <label> add-gadget
|
||||||
|
|
||||||
|
REPO current-branch
|
||||||
|
[
|
||||||
|
drop
|
||||||
|
|
||||||
|
<pile>
|
||||||
|
REPO list-branches
|
||||||
|
|
||||||
|
[| BRANCH |
|
||||||
|
|
||||||
|
BRANCH
|
||||||
|
[
|
||||||
|
drop
|
||||||
|
REPO { "git" "checkout" BRANCH } git-process popup-if-error
|
||||||
|
GADGET refresh-git-remote-gadget
|
||||||
|
]
|
||||||
|
<bevel-button> add-gadget
|
||||||
|
|
||||||
|
]
|
||||||
|
each
|
||||||
|
|
||||||
|
"Select a branch" open-window
|
||||||
|
|
||||||
|
]
|
||||||
|
<bevel-button> add-gadget
|
||||||
|
|
||||||
|
add-gadget
|
||||||
|
|
||||||
|
! Remote button
|
||||||
|
|
||||||
|
<shelf>
|
||||||
|
|
||||||
|
"Remote: " <label> add-gadget
|
||||||
|
|
||||||
|
GADGET remote>>
|
||||||
|
[
|
||||||
|
drop
|
||||||
|
|
||||||
|
<pile>
|
||||||
|
|
||||||
|
REPO list-remotes
|
||||||
|
|
||||||
|
[| REMOTE |
|
||||||
|
|
||||||
|
REMOTE
|
||||||
|
[
|
||||||
|
drop
|
||||||
|
GADGET REMOTE >>remote drop
|
||||||
|
GADGET "master" >>remote-branch drop
|
||||||
|
GADGET refresh-git-remote-gadget
|
||||||
|
]
|
||||||
|
<bevel-button> add-gadget
|
||||||
|
|
||||||
|
]
|
||||||
|
each
|
||||||
|
|
||||||
|
"Select a remote" open-window
|
||||||
|
|
||||||
|
]
|
||||||
|
<bevel-button> add-gadget
|
||||||
|
|
||||||
|
add-gadget
|
||||||
|
|
||||||
|
! Remote branch button
|
||||||
|
|
||||||
|
<shelf>
|
||||||
|
|
||||||
|
"Remote branch: " <label> add-gadget
|
||||||
|
|
||||||
|
GADGET remote-branch>>
|
||||||
|
[
|
||||||
|
drop
|
||||||
|
|
||||||
|
<pile>
|
||||||
|
|
||||||
|
REPO GADGET remote>> list-remote-branches
|
||||||
|
|
||||||
|
[| REMOTE-BRANCH |
|
||||||
|
|
||||||
|
REMOTE-BRANCH
|
||||||
|
[
|
||||||
|
drop
|
||||||
|
GADGET REMOTE-BRANCH >>remote-branch drop
|
||||||
|
GADGET refresh-git-remote-gadget
|
||||||
|
]
|
||||||
|
<bevel-button> add-gadget
|
||||||
|
]
|
||||||
|
|
||||||
|
each
|
||||||
|
|
||||||
|
"Select a remote branch" open-window
|
||||||
|
|
||||||
|
]
|
||||||
|
<bevel-button> add-gadget
|
||||||
|
|
||||||
|
add-gadget
|
||||||
|
|
||||||
|
! Fetch button
|
||||||
|
|
||||||
|
"Fetch"
|
||||||
|
[
|
||||||
|
drop
|
||||||
|
[let | REMOTE [ GADGET remote>> ] |
|
||||||
|
REPO { "git" "fetch" REMOTE } git-process popup-if-error ]
|
||||||
|
|
||||||
|
GADGET refresh-git-remote-gadget
|
||||||
|
]
|
||||||
|
<bevel-button> add-gadget
|
||||||
|
|
||||||
|
! Available changes
|
||||||
|
|
||||||
|
[let | REMOTE [ GADGET remote>> ]
|
||||||
|
REMOTE-BRANCH [ GADGET remote-branch>> ] |
|
||||||
|
|
||||||
|
[let | ARG [ { ".." REMOTE "/" REMOTE-BRANCH } concat ] |
|
||||||
|
|
||||||
|
[let | PROCESS [ REPO { "git" "log" ARG } git-process ] |
|
||||||
|
|
||||||
|
PROCESS stdout>>
|
||||||
|
[
|
||||||
|
<shelf>
|
||||||
|
|
||||||
|
"Changes available:" <label> add-gadget
|
||||||
|
|
||||||
|
"View"
|
||||||
|
[
|
||||||
|
drop
|
||||||
|
PROCESS popup-process-window
|
||||||
|
]
|
||||||
|
<bevel-button> add-gadget
|
||||||
|
|
||||||
|
"Merge"
|
||||||
|
[
|
||||||
|
drop
|
||||||
|
|
||||||
|
[let | ARG [ { REMOTE "/" REMOTE-BRANCH } concat ] |
|
||||||
|
|
||||||
|
REPO { "git" "merge" ARG } git-process popup-process-window
|
||||||
|
|
||||||
|
]
|
||||||
|
|
||||||
|
GADGET refresh-git-remote-gadget
|
||||||
|
|
||||||
|
]
|
||||||
|
<bevel-button> add-gadget
|
||||||
|
|
||||||
|
add-gadget
|
||||||
|
|
||||||
|
]
|
||||||
|
when
|
||||||
|
|
||||||
|
] ] ]
|
||||||
|
|
||||||
|
|
||||||
|
! Pushable changes
|
||||||
|
|
||||||
|
[let | REMOTE [ GADGET remote>> ]
|
||||||
|
REMOTE-BRANCH [ GADGET remote-branch>> ] |
|
||||||
|
|
||||||
|
[let | ARG [ { REMOTE "/" REMOTE-BRANCH ".." } concat ] |
|
||||||
|
|
||||||
|
[let | PROCESS [ REPO { "git" "log" ARG } git-process ] |
|
||||||
|
|
||||||
|
PROCESS stdout>>
|
||||||
|
[
|
||||||
|
<shelf>
|
||||||
|
|
||||||
|
"Pushable changes: " <label> add-gadget
|
||||||
|
|
||||||
|
"View"
|
||||||
|
[
|
||||||
|
drop
|
||||||
|
PROCESS popup-process-window
|
||||||
|
]
|
||||||
|
<bevel-button> add-gadget
|
||||||
|
|
||||||
|
"Push"
|
||||||
|
[
|
||||||
|
drop
|
||||||
|
|
||||||
|
REPO { "git" "push" REMOTE REMOTE-BRANCH }
|
||||||
|
git-process
|
||||||
|
popup-process-window
|
||||||
|
|
||||||
|
GADGET refresh-git-remote-gadget
|
||||||
|
|
||||||
|
]
|
||||||
|
<bevel-button> add-gadget
|
||||||
|
|
||||||
|
add-gadget
|
||||||
|
|
||||||
|
]
|
||||||
|
when
|
||||||
|
|
||||||
|
] ] ]
|
||||||
|
|
||||||
|
drop
|
||||||
|
|
||||||
|
] ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
:: start-fetch-thread ( GADGET -- )
|
||||||
|
|
||||||
|
GADGET f >>closed drop
|
||||||
|
|
||||||
|
[
|
||||||
|
|
||||||
|
[
|
||||||
|
|
||||||
|
GADGET closed>>
|
||||||
|
[ f ]
|
||||||
|
[
|
||||||
|
[let | REPO [ GADGET repository>> ]
|
||||||
|
REMOTE-BRANCH [ GADGET remote-branch>> ] |
|
||||||
|
|
||||||
|
REPO { "git" "fetch" REMOTE-BRANCH } git-process drop ]
|
||||||
|
|
||||||
|
GADGET fetch-period>> sleep
|
||||||
|
|
||||||
|
t
|
||||||
|
]
|
||||||
|
if
|
||||||
|
|
||||||
|
|
||||||
|
]
|
||||||
|
loop
|
||||||
|
|
||||||
|
]
|
||||||
|
|
||||||
|
in-thread ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
:: start-monitor-thread ( GADGET -- )
|
||||||
|
|
||||||
|
GADGET f >>closed drop
|
||||||
|
|
||||||
|
[
|
||||||
|
[
|
||||||
|
[let | MONITOR [ GADGET repository>> t <monitor> ] |
|
||||||
|
|
||||||
|
[
|
||||||
|
GADGET closed>>
|
||||||
|
[ f ]
|
||||||
|
[
|
||||||
|
|
||||||
|
[let | PATH [ MONITOR next-change drop ] |
|
||||||
|
|
||||||
|
".git" PATH subseq?
|
||||||
|
[ ]
|
||||||
|
[
|
||||||
|
micros
|
||||||
|
GADGET last-refresh>> 0 or -
|
||||||
|
1000000 >
|
||||||
|
[
|
||||||
|
GADGET micros >>last-refresh drop
|
||||||
|
GADGET refresh-git-remote-gadget
|
||||||
|
]
|
||||||
|
when
|
||||||
|
]
|
||||||
|
if ]
|
||||||
|
|
||||||
|
t
|
||||||
|
|
||||||
|
]
|
||||||
|
if
|
||||||
|
]
|
||||||
|
loop
|
||||||
|
]
|
||||||
|
]
|
||||||
|
with-monitors
|
||||||
|
]
|
||||||
|
in-thread ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
M: <git-remote-gadget> pref-dim* ( gadget -- dim ) drop { 500 500 } ;
|
||||||
|
|
||||||
|
M:: <git-remote-gadget> graft* ( GADGET -- )
|
||||||
|
GADGET start-fetch-thread
|
||||||
|
GADGET start-monitor-thread ;
|
||||||
|
|
||||||
|
M:: <git-remote-gadget> ungraft* ( GADGET -- ) GADGET t >>closed drop ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
:: git-remote-tool ( REPO -- )
|
||||||
|
|
||||||
|
<git-remote-gadget> new-gadget
|
||||||
|
|
||||||
|
{ 0 1 } >>orientation
|
||||||
|
1 >>fill
|
||||||
|
|
||||||
|
REPO >>repository
|
||||||
|
|
||||||
|
"origin" >>remote
|
||||||
|
|
||||||
|
"master" >>remote-branch
|
||||||
|
|
||||||
|
5 minutes >>fetch-period
|
||||||
|
|
||||||
|
dup refresh-git-remote-gadget
|
||||||
|
|
||||||
|
"git-remote-tool" open-window ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
: factor-git-remote-tool ( -- ) "resource:" git-remote-tool ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
MAIN: factor-git-remote-tool
|
||||||
|
|
@ -0,0 +1,29 @@
|
||||||
|
Vim support for Factor
|
||||||
|
----------------------
|
||||||
|
|
||||||
|
This directory contains various support files that make editing Factor code
|
||||||
|
more pleasant in Vim. The file-layout exactly matches the Vim runtime
|
||||||
|
structure, so you can install them by copying the contents of this directory
|
||||||
|
into ~/.vim/ or the equivalent path on other platforms (Open Vim and type
|
||||||
|
":help 'runtimepath'" for details).
|
||||||
|
|
||||||
|
The current set of files is as follows:
|
||||||
|
|
||||||
|
ftdetect/factor.vim
|
||||||
|
Teach Vim when to load Factor support files.
|
||||||
|
ftplugin/factor_settings.vim
|
||||||
|
Teach Vim to follow the Factor Coding Style guidelines.
|
||||||
|
syntax/factor.vim
|
||||||
|
Syntax highlighting for Factor code.
|
||||||
|
|
||||||
|
Note: The syntax-highlighting file is automatically generated to include the
|
||||||
|
names of all the vocabularies Factor knows about. To regenerate it manually,
|
||||||
|
run the following code in the listener:
|
||||||
|
|
||||||
|
USE: editors.vim.generate-syntax
|
||||||
|
|
||||||
|
generate-vim-syntax
|
||||||
|
|
||||||
|
...or run it from the command-line:
|
||||||
|
|
||||||
|
factor -run=editors.vim.generate-syntax
|
||||||
|
|
@ -0,0 +1 @@
|
||||||
|
autocmd BufRead,BufNewFile *.factor,{,.}factor*-rc set filetype=factor
|
||||||
|
|
@ -0,0 +1,17 @@
|
||||||
|
" Code formatting settings loosely adapted from:
|
||||||
|
" http://concatenative.org/wiki/view/Factor/Coding%20Style
|
||||||
|
|
||||||
|
" Tabs are not allowed in Factor source files; use four spaces instead.
|
||||||
|
setlocal expandtab tabstop=4 shiftwidth=4 softtabstop=4
|
||||||
|
|
||||||
|
" Try to limit lines to 64 characters, except for documentation, which can be
|
||||||
|
" any length.
|
||||||
|
if expand("%:t") !~ "-docs\.factor$"
|
||||||
|
setlocal textwidth=64
|
||||||
|
|
||||||
|
" Mark anything in column 64 or beyond as a syntax error.
|
||||||
|
match Error /\%>63v.\+/
|
||||||
|
endif
|
||||||
|
|
||||||
|
" Teach Vim what comments look like.
|
||||||
|
setlocal comments+=b:!,b:#!
|
||||||
Loading…
Reference in New Issue