diff --git a/basis/editors/gvim/gvim.factor b/basis/editors/gvim/gvim.factor index ad6fb65cfb..8fb4d6b23d 100644 --- a/basis/editors/gvim/gvim.factor +++ b/basis/editors/gvim/gvim.factor @@ -8,7 +8,7 @@ SINGLETON: gvim HOOK: gvim-path io-backend ( -- path ) M: gvim vim-command ( file line -- string ) - [ gvim-path , swap , "+" swap number>string append , ] { } make ; + [ gvim-path , "+" swap number>string append , , ] { } make ; gvim vim-editor set-global diff --git a/basis/editors/vim/generate-syntax/generate-syntax.factor b/basis/editors/vim/generate-syntax/generate-syntax.factor index 325a451a0b..74b04c346f 100644 --- a/basis/editors/vim/generate-syntax/generate-syntax.factor +++ b/basis/editors/vim/generate-syntax/generate-syntax.factor @@ -1,6 +1,5 @@ ! Generate a new factor.vim file for syntax highlighting -USING: http.server.templating http.server.templating.fhtml -io.files ; +USING: html.templates html.templates.fhtml io.files io.pathnames ; IN: editors.vim.generate-syntax : generate-vim-syntax ( -- ) diff --git a/basis/help/handbook/handbook.factor b/basis/help/handbook/handbook.factor index 69c2046834..f63bb35f65 100644 --- a/basis/help/handbook/handbook.factor +++ b/basis/help/handbook/handbook.factor @@ -209,7 +209,8 @@ ARTICLE: "tools" "Developer tools" { $subsection "timing" } { $subsection "tools.disassembler" } "Deployment tools:" -{ $subsection "tools.deploy" } ; +{ $subsection "tools.deploy" } +{ $see-also "ui-tools" } ; ARTICLE: "article-index" "Article index" { $index [ articles get keys ] } ; diff --git a/core/parser/parser-docs.factor b/core/parser/parser-docs.factor index 625c1e9c43..4da76468e8 100644 --- a/core/parser/parser-docs.factor +++ b/core/parser/parser-docs.factor @@ -34,6 +34,7 @@ ARTICLE: "defining-words" "Defining words" { $see POSTPONE: SYMBOL: } "The key factor in the definition of " { $link POSTPONE: SYMBOL: } " is " { $link CREATE } ", which reads a token from the input and creates a word with that name. This word is then passed to " { $link define-symbol } "." { $subsection CREATE } +{ $subsection CREATE-WORD } "Colon definitions are defined in a more elaborate way:" { $subsection POSTPONE: : } "The " { $link POSTPONE: : } " word first calls " { $link CREATE } ", and then reads input until reaching " { $link POSTPONE: ; } " using a utility word:" diff --git a/extra/L-system/L-system.factor b/extra/L-system/L-system.factor index 5bc7ce1db6..0dbf94b1c6 100644 --- a/extra/L-system/L-system.factor +++ b/extra/L-system/L-system.factor @@ -207,7 +207,8 @@ DEFER: default-L-parser-values ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : save-turtle ( turtle -- turtle ) dup clone over saved>> push ; -: restore-turtle ( turtle -- turtle ) saved>> pop ; + +: restore-turtle ( turtle -- turtle ) saved>> pop dup color>> set-color ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/L-system/models/tree-5/tree-5.factor b/extra/L-system/models/tree-5/tree-5.factor new file mode 100644 index 0000000000..2647698351 --- /dev/null +++ b/extra/L-system/models/tree-5/tree-5.factor @@ -0,0 +1,37 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.tree-5 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: tree-5 ( -- ) + + L-parser-dialect >>commands + + [ 5 >>angle ] >>turtle-values + + "c(4)FFS" >>axiom + + { + { "S" "FFR>(60)R>(60)R>(60)R>(60)R>(60)R>(30)S" } + { "R" "[Ba]" } + { "a" "$tF[Cx]Fb" } + { "b" "$tF[Dy]Fa" } + { "B" "&B" } + { "C" "+C" } + { "D" "-D" } + + { "x" "a" } + { "y" "b" } + + { "F" "'(1.25)F'(.8)" } + } + >>rules ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: main ( -- ) [ L-system tree-5 "L-system" open-window ] with-ui ; + +MAIN: main + \ No newline at end of file diff --git a/extra/git-tool/git-tool.factor b/extra/git-tool/git-tool.factor new file mode 100644 index 0000000000..1b079ed0ac --- /dev/null +++ b/extra/git-tool/git-tool.factor @@ -0,0 +1,446 @@ + +USING: accessors combinators.cleave combinators.short-circuit +concurrency.combinators destructors fry io io.directories +io.encodings io.encodings.utf8 io.launcher io.pathnames +io.pipes io.ports kernel locals math namespaces sequences +splitting strings ui ui.gadgets ui.gadgets.buttons +ui.gadgets.editors ui.gadgets.labels ui.gadgets.packs +ui.gadgets.tracks ; + +IN: git-status + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: head** ( seq obj -- seq/f ) dup number? [ head ] [ dupd find drop head ] if ; + +: tail** ( seq obj -- seq/f ) + dup number? + [ tail ] + [ dupd find drop [ tail ] [ drop f ] if* ] + if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: ( DESC -- process stream stream ) + [ + [let | STDOUT-PIPE [ (pipe) |dispose ] + STDERR-PIPE [ (pipe) |dispose ] | + + [let | PROCESS [ DESC >process ] | + + PROCESS + [ STDOUT-PIPE out>> or ] change-stdout + [ STDERR-PIPE out>> or ] change-stderr + run-detached + + STDOUT-PIPE out>> dispose + STDERR-PIPE out>> dispose + + STDOUT-PIPE in>> utf8 + STDERR-PIPE in>> utf8 ] ] + ] + with-destructors ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: run-process/result ( desc -- process ) + + { + [ contents [ string-lines ] [ f ] if* ] + [ contents [ string-lines ] [ f ] if* ] + } + parallel-spread + [ >>stdout ] [ >>stderr ] bi* + dup wait-for-process >>status ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! process popup windows +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: popup-window ( title contents -- ) + dup string? [ ] [ "\n" join ] if + tuck set-editor-string swap open-window ; + +: popup-process-window ( process -- ) + [ stdout>> [ "output" swap popup-window ] when* ] + [ stderr>> [ "error" swap popup-window ] when* ] + [ + [ stdout>> ] [ stderr>> ] bi or not + [ "Process" "NO OUTPUT" popup-window ] + when + ] + tri ; + +: popup-if-error ( process -- ) + { [ status>> 0 = not ] [ popup-process-window t ] } 1&& drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: git-process ( REPO DESC -- process ) + REPO [ DESC run-process/result ] with-directory ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: git-status-section ( lines section -- lines/f ) + '[ _ = ] tail** + [ + [ "#\t" head? ] tail** + [ "#\t" head? not ] head** + [ 2 tail ] map + ] + [ f ] + if* ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: colon ( -- ch ) CHAR: : ; +: space ( -- ch ) 32 ; + +: git-status-line-file ( line -- file ) + { [ colon = ] 1 [ space = not ] } [ tail** ] each ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: + repository + to-commit-new + to-commit-modified + to-commit-deleted + modified + deleted + untracked ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: check-empty ( seq -- seq/f ) dup empty? [ drop f ] when ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: refresh-git-status ( GIT-STATUS -- GIT-STATUS ) + + [let | LINES [ GIT-STATUS repository>> "git-status" git-process stdout>> ] | + + GIT-STATUS + + LINES "# Changes to be committed:" git-status-section + [ "new file:" head? ] filter + [ git-status-line-file ] map + check-empty + >>to-commit-new + + LINES "# Changes to be committed:" git-status-section + [ "modified:" head? ] filter + [ git-status-line-file ] map + check-empty + >>to-commit-modified + + LINES "# Changes to be committed:" git-status-section + [ "deleted:" head? ] filter + [ git-status-line-file ] map + check-empty + >>to-commit-deleted + + LINES "# Changed but not updated:" git-status-section + [ "modified:" head? ] filter + [ git-status-line-file ] map + check-empty + >>modified + + LINES "# Changed but not updated:" git-status-section + [ "deleted:" head? ] filter + [ git-status-line-file ] map + check-empty + >>deleted + + LINES "# Untracked files:" git-status-section >>untracked ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: git-status ( REPO -- ) + + new REPO >>repository refresh-git-status ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: factor-git-status ( -- ) "resource:" git-status ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! git-tool +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: to-commit ( -- seq ) + { to-commit-new>> to-commit-modified>> to-commit-deleted>> } 1arr concat ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: refresh-status-pile ( STATUS PILE -- ) + + STATUS refresh-git-status drop + + PILE clear-gadget + + PILE + + ! Commit section + + [wlet | add-commit-path-button [| TEXT PATH | + + { 1 0 } + + TEXT