diff --git a/basis/http/client/client.factor b/basis/http/client/client.factor index f2c0a862eb..f8106f4c83 100644 --- a/basis/http/client/client.factor +++ b/basis/http/client/client.factor @@ -34,6 +34,8 @@ IN: http.client GENERIC: >post-data ( object -- post-data ) +M: f >post-data ; + M: post-data >post-data ; M: string >post-data @@ -41,15 +43,13 @@ M: string >post-data "application/octet-stream" swap >>data ; -M: byte-array >post-data - "application/octet-stream" - swap >>data ; - M: assoc >post-data "application/x-www-form-urlencoded" swap >>params ; -M: f >post-data ; +M: object >post-data + "application/octet-stream" + swap >>data ; : normalize-post-data ( request -- request ) dup post-data>> [ @@ -63,8 +63,10 @@ M: f >post-data ; normalize-post-data ; : write-post-data ( request -- request ) - dup method>> [ "POST" = ] [ "PUT" = ] bi or - [ dup post-data>> data>> write ] when ; + dup method>> { "POST" "PUT" } member? [ + dup post-data>> data>> dup sequence? + [ write ] [ output-stream get stream-copy ] if + ] when ; : write-request ( request -- ) unparse-post-data diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index f52a34ff28..2bf8f1b98d 100644 --- a/extra/fuel/fuel.factor +++ b/extra/fuel/fuel.factor @@ -1,10 +1,9 @@ ! Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays assocs compiler.units definitions fuel.eval -fuel.help help.markup help.topics io.pathnames kernel math math.order -memoize namespaces parser sequences sets sorting tools.crossref -tools.scaffold tools.vocabs vocabs vocabs.loader vocabs.parser words ; +USING: assocs compiler.units fuel.eval fuel.help fuel.remote fuel.xref +help.topics io.pathnames kernel namespaces parser sequences +tools.scaffold vocabs.loader ; IN: fuel @@ -50,92 +49,40 @@ PRIVATE> ! Edit locations - [ first (normalize-path) ] [ drop f ] if ] - [ dup length 1 > [ second ] [ drop 1 ] if ] bi ; - -: fuel-get-loc ( object -- ) - fuel-normalize-loc 2array fuel-eval-set-result ; - -PRIVATE> - -: fuel-get-edit-location ( word -- ) where fuel-get-loc ; inline +: fuel-get-word-location ( word -- ) + word-location fuel-eval-set-result ; : fuel-get-vocab-location ( vocab -- ) - >vocab-link fuel-get-edit-location ; inline + vocab-location fuel-eval-set-result ; -: fuel-get-doc-location ( word -- ) props>> "help-loc" swap at fuel-get-loc ; +: fuel-get-doc-location ( word -- ) + doc-location fuel-eval-set-result ; -: fuel-get-article-location ( name -- ) article loc>> fuel-get-loc ; +: fuel-get-article-location ( name -- ) + article-location fuel-eval-set-result ; + +: fuel-get-vocabs ( -- ) + get-vocabs fuel-eval-set-result ; + +: fuel-get-vocabs/prefix ( prefix -- ) + get-vocabs/prefix fuel-eval-set-result ; + +: fuel-get-words ( prefix names -- ) + get-vocabs-words/prefix fuel-eval-set-result ; ! Cross-references -xref ( word -- xref ) - [ name>> ] [ vocabulary>> ] [ where fuel-normalize-loc ] tri 4array ; +: fuel-callees-xref ( word -- ) callees-xref fuel-eval-set-result ; -: fuel-sort-xrefs ( seq -- seq' ) - [ [ first ] dip first <=> ] sort ; inline +: fuel-apropos-xref ( str -- ) apropos-xref fuel-eval-set-result ; -: fuel-format-xrefs ( seq -- seq' ) - [ word? ] filter [ fuel-word>xref ] map ; inline +: fuel-vocab-xref ( vocab -- ) vocab-xref fuel-eval-set-result ; -: (fuel-index) ( seq -- seq ) - [ [ >link name>> ] [ article-title ] bi 2array \ $subsection prefix ] map ; +: fuel-vocab-uses-xref ( vocab -- ) vocab-uses-xref fuel-eval-set-result ; -PRIVATE> - -: fuel-callers-xref ( word -- ) - usage fuel-format-xrefs fuel-sort-xrefs fuel-eval-set-result ; inline - -: fuel-callees-xref ( word -- ) - uses fuel-format-xrefs fuel-sort-xrefs fuel-eval-set-result ; inline - -: fuel-apropos-xref ( str -- ) - words-matching fuel-format-xrefs fuel-eval-set-result ; inline - -: fuel-vocab-xref ( vocab -- ) - words fuel-format-xrefs fuel-eval-set-result ; inline - -: fuel-index ( quot: ( -- seq ) -- ) - call (fuel-index) fuel-eval-set-result ; inline - -! Completion support - -vocab-link words [ name>> ] map ; - -: fuel-current-words ( -- seq ) - use get [ keys ] map concat ; inline - -: fuel-vocabs-words ( names -- seq ) - prune [ (fuel-vocab-words) ] map concat ; inline - -: (fuel-get-words) ( prefix names/f -- seq ) - [ fuel-vocabs-words ] [ fuel-current-words ] if* natural-sort - swap fuel-filter-prefix ; - -PRIVATE> - -: fuel-get-vocabs ( -- ) - (fuel-get-vocabs) fuel-eval-set-result ; - -: fuel-get-vocabs/prefix ( prefix -- ) - (fuel-get-vocabs) swap fuel-filter-prefix fuel-eval-set-result ; - -: fuel-get-words ( prefix names -- ) - (fuel-get-words) fuel-eval-set-result ; +: fuel-vocab-usage-xref ( vocab -- ) vocab-usage-xref fuel-eval-set-result ; ! Help support @@ -155,6 +102,8 @@ PRIVATE> : fuel-vocab-summary ( name -- ) (fuel-vocab-summary) fuel-eval-set-result ; +: fuel-index ( quot -- ) call format-index fuel-eval-set-result ; + : fuel-get-vocabs/tag ( tag -- ) (fuel-get-vocabs/tag) fuel-eval-set-result ; @@ -174,3 +123,6 @@ PRIVATE> : fuel-scaffold-get-root ( name -- ) find-vocab-root fuel-eval-set-result ; +! Remote connection + +MAIN: fuel-start-remote-listener* diff --git a/extra/fuel/help/help.factor b/extra/fuel/help/help.factor index ff7239ac8f..e70327bd35 100644 --- a/extra/fuel/help/help.factor +++ b/extra/fuel/help/help.factor @@ -109,3 +109,6 @@ MEMO: (fuel-get-vocabs/author) ( author -- element ) MEMO: (fuel-get-vocabs/tag) ( tag -- element ) [ "Vocabularies tagged " prepend \ $heading swap 2array ] [ tagged fuel-vocab-list ] bi 2array ; + +: format-index ( seq -- seq ) + [ [ >link name>> ] [ article-title ] bi 2array \ $subsection prefix ] map ; diff --git a/extra/fuel/remote/authors.txt b/extra/fuel/remote/authors.txt new file mode 100644 index 0000000000..48f802a3cd --- /dev/null +++ b/extra/fuel/remote/authors.txt @@ -0,0 +1 @@ +Jose Antonio Ortega Ruiz \ No newline at end of file diff --git a/extra/fuel/remote/remote.factor b/extra/fuel/remote/remote.factor new file mode 100644 index 0000000000..454265d5d8 --- /dev/null +++ b/extra/fuel/remote/remote.factor @@ -0,0 +1,28 @@ +! Copyright (C) 2009 Jose Antonio Ortega Ruiz. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors io io.encodings.utf8 io.servers.connection kernel +listener math ; + +IN: fuel.remote + + + "tty-server" >>name + utf8 >>encoding + swap local-server >>insecure + [ listener ] >>handler + f >>timeout ; + +: print-banner ( -- ) + "Starting server. Connect with 'M-x connect-to-factor' in Emacs" + write nl flush ; + +PRIVATE> + +: fuel-start-remote-listener ( port/f -- ) + print-banner integer? [ 9000 ] unless* server start-server ; + +: fuel-start-remote-listener* ( -- ) f fuel-start-remote-listener ; + diff --git a/extra/fuel/xref/authors.txt b/extra/fuel/xref/authors.txt new file mode 100644 index 0000000000..48f802a3cd --- /dev/null +++ b/extra/fuel/xref/authors.txt @@ -0,0 +1 @@ +Jose Antonio Ortega Ruiz \ No newline at end of file diff --git a/extra/fuel/xref/xref.factor b/extra/fuel/xref/xref.factor new file mode 100644 index 0000000000..5f5e28d1d2 --- /dev/null +++ b/extra/fuel/xref/xref.factor @@ -0,0 +1,69 @@ +! Copyright (C) 2009 Jose Antonio Ortega Ruiz. +! See http://factorcode.org/license.txt for BSD license. + +USING: accessors arrays assocs definitions help.topics io.pathnames +kernel math math.order memoize namespaces sequences sets sorting +tools.crossref tools.vocabs vocabs vocabs.parser words ; + +IN: fuel.xref + + [ first (normalize-path) ] [ drop f ] if ] + [ dup length 1 > [ second ] [ drop 1 ] if ] bi ; + +: get-loc ( object -- loc ) normalize-loc 2array ; + +: word>xref ( word -- xref ) + [ name>> ] [ vocabulary>> ] [ where normalize-loc ] tri 4array ; + +: vocab>xref ( vocab -- xref ) + dup dup >vocab-link where normalize-loc 4array ; + +: sort-xrefs ( seq -- seq' ) + [ [ first ] dip first <=> ] sort ; inline + +: format-xrefs ( seq -- seq' ) + [ word? ] filter [ word>xref ] map ; inline + +: filter-prefix ( seq prefix -- seq ) + [ drop-prefix nip length 0 = ] curry filter prune ; inline + +MEMO: (vocab-words) ( name -- seq ) + >vocab-link words [ name>> ] map ; + +: current-words ( -- seq ) + use get [ keys ] map concat ; inline + +: vocabs-words ( names -- seq ) + prune [ (vocab-words) ] map concat ; inline + +PRIVATE> + +: callers-xref ( word -- seq ) usage format-xrefs sort-xrefs ; + +: callees-xref ( word -- seq ) uses format-xrefs sort-xrefs ; + +: apropos-xref ( str -- seq ) words-matching format-xrefs ; + +: vocab-xref ( vocab -- seq ) words format-xrefs ; + +: word-location ( word -- loc ) where get-loc ; + +: vocab-location ( vocab -- loc ) >vocab-link where get-loc ; + +: vocab-uses-xref ( vocab -- seq ) vocab-uses [ vocab>xref ] map ; + +: vocab-usage-xref ( vocab -- seq ) vocab-usage [ vocab>xref ] map ; + +: doc-location ( word -- loc ) props>> "help-loc" swap at get-loc ; + +: article-location ( name -- loc ) article loc>> get-loc ; + +: get-vocabs ( -- seq ) all-vocabs-seq [ vocab-name ] map ; + +: get-vocabs/prefix ( prefix -- seq ) get-vocabs swap filter-prefix ; + +: get-vocabs-words/prefix ( prefix names/f -- seq ) + [ vocabs-words ] [ current-words ] if* natural-sort swap filter-prefix ; diff --git a/extra/git-tool/git-tool.factor b/extra/git-tool/git-tool.factor deleted file mode 100644 index ff45d32c65..0000000000 --- a/extra/git-tool/git-tool.factor +++ /dev/null @@ -1,470 +0,0 @@ - -USING: accessors combinators.cleave combinators.short-circuit -concurrency.combinators destructors fry io io.directories -io.encodings io.encodings.utf8 io.launcher io.monitors -io.pathnames io.pipes io.ports kernel locals math namespaces -sequences splitting strings threads ui ui.gadgets -ui.gadgets.buttons ui.gadgets.editors ui.gadgets.labels -ui.gadgets.packs ui.gadgets.tracks ; - -IN: git-tool - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: 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 ( STATUS -- STATUS ) - - [let | LINES [ STATUS repository>> { "git" "status" } git-process stdout>> ] | - - 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