Resolve conflict
commit
3e7df398c7
|
@ -65,14 +65,15 @@ TUPLE: no-parent-directory path ;
|
||||||
\ no-parent-directory construct-boa throw ;
|
\ no-parent-directory construct-boa throw ;
|
||||||
|
|
||||||
: parent-directory ( path -- parent )
|
: parent-directory ( path -- parent )
|
||||||
trim-path-separators
|
trim-path-separators {
|
||||||
dup root-directory? [ ] [
|
{ [ dup empty? ] [ drop "/" ] }
|
||||||
dup last-path-separator drop dup [
|
{ [ dup root-directory? ] [ ] }
|
||||||
1+ cut
|
{ [ dup [ path-separator? ] contains? not ] [ drop "." ] }
|
||||||
special-directory?
|
{ [ t ] [
|
||||||
[ no-parent-directory ] when
|
last-path-separator drop 1+ cut
|
||||||
] [ 2drop "." ] if
|
special-directory? [ no-parent-directory ] when
|
||||||
] if ;
|
] }
|
||||||
|
} cond ;
|
||||||
|
|
||||||
: file-name ( path -- string )
|
: file-name ( path -- string )
|
||||||
dup last-path-separator [ 1+ tail ] [ drop ] if ;
|
dup last-path-separator [ 1+ tail ] [ drop ] if ;
|
||||||
|
|
|
@ -0,0 +1,99 @@
|
||||||
|
! Copyright (C) 2007 Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: io.server io.sockets io strings parser byte-arrays
|
||||||
|
namespaces ui.clipboards ui.gadgets.panes ui.gadgets.scrollers
|
||||||
|
ui.gadgets.buttons ui.gadgets.tracks ui.gadgets ui.operations
|
||||||
|
ui.commands ui kernel splitting combinators continuations
|
||||||
|
sequences io.streams.duplex models ;
|
||||||
|
IN: network-clipboard
|
||||||
|
|
||||||
|
: clipboard-port 4444 ;
|
||||||
|
|
||||||
|
: get-request
|
||||||
|
clipboard get clipboard-contents write ;
|
||||||
|
|
||||||
|
: contents ( -- str )
|
||||||
|
[ 1024 read dup ] [ ] [ drop ] unfold concat ;
|
||||||
|
|
||||||
|
: set-request
|
||||||
|
contents clipboard get set-clipboard-contents ;
|
||||||
|
|
||||||
|
: clipboard-server ( -- )
|
||||||
|
clipboard-port internet-server "clip-server" [
|
||||||
|
readln {
|
||||||
|
{ "GET" [ get-request ] }
|
||||||
|
{ "SET" [ set-request ] }
|
||||||
|
} case
|
||||||
|
] with-server ;
|
||||||
|
|
||||||
|
\ clipboard-server H{
|
||||||
|
{ +nullary+ t }
|
||||||
|
{ +listener+ t }
|
||||||
|
} define-command
|
||||||
|
|
||||||
|
: <client-datagram> ( -- datagram )
|
||||||
|
"0.0.0.0" 0 <inet4> <datagram> ;
|
||||||
|
|
||||||
|
: with-client ( addrspec quot -- )
|
||||||
|
>r <client> r> with-stream ; inline
|
||||||
|
|
||||||
|
: send-text ( text host -- )
|
||||||
|
clipboard-port <inet4> [ write ] with-client ;
|
||||||
|
|
||||||
|
TUPLE: host name ;
|
||||||
|
|
||||||
|
C: <host> host
|
||||||
|
|
||||||
|
M: string host-name ;
|
||||||
|
|
||||||
|
: send-clipboard ( host -- )
|
||||||
|
host-name
|
||||||
|
"SET\n" clipboard get clipboard-contents append swap send-text ;
|
||||||
|
|
||||||
|
[ host? ] \ send-clipboard H{ } define-operation
|
||||||
|
|
||||||
|
: ask-text ( text host -- )
|
||||||
|
clipboard-port <inet4>
|
||||||
|
[ write flush contents ] with-client ;
|
||||||
|
|
||||||
|
: receive-clipboard ( host -- )
|
||||||
|
host-name
|
||||||
|
"GET\n" swap ask-text
|
||||||
|
clipboard get set-clipboard-contents ;
|
||||||
|
|
||||||
|
[ host? ] \ receive-clipboard H{ } define-operation
|
||||||
|
|
||||||
|
: hosts. ( seq -- )
|
||||||
|
"Hosts:" print
|
||||||
|
[ dup <host> write-object nl ] each ;
|
||||||
|
|
||||||
|
TUPLE: network-clipboard-tool ;
|
||||||
|
|
||||||
|
\ network-clipboard-tool "toolbar" f {
|
||||||
|
{ f clipboard-server }
|
||||||
|
} define-command-map
|
||||||
|
|
||||||
|
: <network-clipboard-tool> ( model -- gadget )
|
||||||
|
\ network-clipboard-tool construct-empty [
|
||||||
|
toolbar,
|
||||||
|
[ hosts. ] <pane-control> <scroller> 1 track,
|
||||||
|
] { 0 1 } build-track ;
|
||||||
|
|
||||||
|
SYMBOL: network-clipboards
|
||||||
|
|
||||||
|
{ } <model> network-clipboards set-global
|
||||||
|
|
||||||
|
: set-network-clipboards ( seq -- )
|
||||||
|
network-clipboards get set-model ;
|
||||||
|
|
||||||
|
: add-network-clipboard ( host -- )
|
||||||
|
network-clipboards get [ swap add ] change-model ;
|
||||||
|
|
||||||
|
: network-clipboard-tool ( -- )
|
||||||
|
[
|
||||||
|
network-clipboards get
|
||||||
|
<network-clipboard-tool>
|
||||||
|
"Network clipboard" open-window
|
||||||
|
] with-ui ;
|
||||||
|
|
||||||
|
MAIN: network-clipboard-tool
|
|
@ -1,7 +1,7 @@
|
||||||
USING: sequences rss arrays concurrency kernel sorting
|
USING: sequences rss arrays concurrency kernel sorting
|
||||||
html.elements io assocs namespaces math threads vocabs html
|
html.elements io assocs namespaces math threads vocabs html
|
||||||
furnace http.server.templating calendar math.parser splitting
|
furnace http.server.templating calendar math.parser splitting
|
||||||
continuations debugger system ;
|
continuations debugger system http.server.responders ;
|
||||||
IN: webapps.planet
|
IN: webapps.planet
|
||||||
|
|
||||||
TUPLE: posting author title date link body ;
|
TUPLE: posting author title date link body ;
|
||||||
|
@ -92,7 +92,7 @@ SYMBOL: cached-postings
|
||||||
cached-postings get 4 head print-posting-summaries ;
|
cached-postings get 4 head print-posting-summaries ;
|
||||||
|
|
||||||
: planet-factor ( -- )
|
: planet-factor ( -- )
|
||||||
[
|
serving-html [
|
||||||
"resource:extra/webapps/planet/planet.fhtml"
|
"resource:extra/webapps/planet/planet.fhtml"
|
||||||
run-template-file
|
run-template-file
|
||||||
] with-html-stream ;
|
] with-html-stream ;
|
||||||
|
|
Loading…
Reference in New Issue