diff --git a/core/io/files/files.factor b/core/io/files/files.factor index c4aac6d4a2..498d23b3ca 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -65,14 +65,15 @@ TUPLE: no-parent-directory path ; \ no-parent-directory construct-boa throw ; : parent-directory ( path -- parent ) - trim-path-separators - dup root-directory? [ ] [ - dup last-path-separator drop dup [ - 1+ cut - special-directory? - [ no-parent-directory ] when - ] [ 2drop "." ] if - ] if ; + trim-path-separators { + { [ dup empty? ] [ drop "/" ] } + { [ dup root-directory? ] [ ] } + { [ dup [ path-separator? ] contains? not ] [ drop "." ] } + { [ t ] [ + last-path-separator drop 1+ cut + special-directory? [ no-parent-directory ] when + ] } + } cond ; : file-name ( path -- string ) dup last-path-separator [ 1+ tail ] [ drop ] if ; diff --git a/extra/network-clipboard/network-clipboard.factor b/extra/network-clipboard/network-clipboard.factor new file mode 100755 index 0000000000..93633a6051 --- /dev/null +++ b/extra/network-clipboard/network-clipboard.factor @@ -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 diff --git a/extra/webapps/planet/planet.factor b/extra/webapps/planet/planet.factor index 3f7fed6446..75302eb59c 100644 --- a/extra/webapps/planet/planet.factor +++ b/extra/webapps/planet/planet.factor @@ -1,7 +1,7 @@ USING: sequences rss arrays concurrency kernel sorting html.elements io assocs namespaces math threads vocabs html furnace http.server.templating calendar math.parser splitting -continuations debugger system ; +continuations debugger system http.server.responders ; IN: webapps.planet TUPLE: posting author title date link body ; @@ -92,7 +92,7 @@ SYMBOL: cached-postings cached-postings get 4 head print-posting-summaries ; : planet-factor ( -- ) - [ + serving-html [ "resource:extra/webapps/planet/planet.fhtml" run-template-file ] with-html-stream ;