Resolve conflict

release
Slava Pestov 2007-11-12 17:11:17 -05:00
commit 3e7df398c7
3 changed files with 110 additions and 10 deletions

View File

@ -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 ;

View File

@ -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

View File

@ -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 ;