Merge branch 'master' into irc

diff --git a/extra/irc/client/base/base.factor b/extra/irc/client/base/base.factor
index f54e18ac4bf94537d4e1a6f47a05c7b84fc55fe2..318a1ab1e3225f96a3e475296217b3908417f858 100644 (file)
--- a/extra/irc/client/base/base.factor
+++ b/extra/irc/client/base/base.factor
@@ -19,7 +19,7 @@ SYMBOL: current-irc-client
 
 UNION: to-target privmsg notice ;
 UNION: to-channel join part topic kick rpl-channel-modes
-                  rpl-notopic rpl-topic rpl-names rpl-names-end ;
+                  topic rpl-names rpl-names-end ;
 UNION: to-one-chat to-target to-channel mode ;
 UNION: to-many-chats nick quit ;
 UNION: to-all-chats irc-end irc-disconnected irc-connected ;

diff --git a/extra/irc/client/chats/chats.factor b/extra/irc/client/chats/chats.factor
index 7910afb22ae91870c7b0b597735a54a3f8eebd0c..3f6cf4945d8df49402d5b558584383c92bd46895 100644 (file)
--- a/extra/irc/client/chats/chats.factor
+++ b/extra/irc/client/chats/chats.factor
@@ -33,7 +33,8 @@ TUPLE: irc-profile server port nickname password ;
 C: <irc-profile> irc-profile
 
 TUPLE: irc-client profile stream in-messages out-messages
-       chats is-running nick connect reconnect-time is-ready
+       chats is-running nick connect is-ready
+       reconnect-time reconnect-attempts
        exceptions ;
 
 : <irc-client> ( profile -- irc-client )
@@ -43,8 +44,9 @@ TUPLE: irc-client profile stream in-messages out-messages
         <mailbox>  >>in-messages
         <mailbox>  >>out-messages
         H{ } clone >>chats
-        15 seconds >>reconnect-time
+        30 seconds >>reconnect-time
+        10         >>reconnect-attempts
         V{ } clone >>exceptions
-        [ <inet> latin1 <client> ] >>connect ;
+        [ <inet> latin1 <client> drop ] >>connect ;
 
 SINGLETONS: irc-chat-end irc-end irc-disconnected irc-connected ;

diff --git a/extra/irc/client/internals/internals-tests.factor b/extra/irc/client/internals/internals-tests.factor
index 27b5648f973e162d482ba5a13bb90d0779c2435e..2c26188e0450ad0446e04a24ab162b4aabe5121b 100644 (file)
--- a/extra/irc/client/internals/internals-tests.factor
+++ b/extra/irc/client/internals/internals-tests.factor
@@ -76,7 +76,7 @@ M: mb-writer dispose drop ;
 ! Test connect
 { V{ "NICK factorbot" "USER factorbot hostname servername :irc.factor" } } [
     "someserver" irc-port "factorbot" f <irc-profile> <irc-client>
-    [ 2drop <test-stream> t ] >>connect
+    [ 2drop <test-stream> ] >>connect
     [
         (connect-irc)
         (do-login)

diff --git a/extra/irc/client/internals/internals.factor b/extra/irc/client/internals/internals.factor
index 5bae054e1836cc13adfd0e28d04787b13ab8d575..0a4fe118309d36fd4de989220bff6142c3b5984b 100644 (file)
--- a/extra/irc/client/internals/internals.factor
+++ b/extra/irc/client/internals/internals.factor
@@ -3,10 +3,17 @@
 USING: accessors assocs arrays concurrency.mailboxes continuations destructors
 hashtables io irc.client.base irc.client.chats irc.messages kernel namespaces
 strings words.symbol irc.messages.base irc.client.participants fry threads
-combinators irc.messages.parser ;
+combinators irc.messages.parser math ;
 EXCLUDE: sequences => join ;
 IN: irc.client.internals
 
+: do-connect ( server port quot: ( host port -- stream ) attempts -- stream/f )
+    dup 0 > [
+        [ drop call( host port -- stream ) ]
+        [ drop 15 sleep 1- do-connect ]
+        recover
+    ] [ 2drop 2drop f ] if ;
+
 : /NICK ( nick -- ) "NICK " prepend irc-print ;
 : /PONG ( text -- ) "PONG " prepend irc-print ;
 
@@ -15,18 +22,27 @@ IN: irc.client.internals
     "USER " prepend " hostname servername :irc.factor" append irc-print ;
 
 : /CONNECT ( server port -- stream )
-    irc> connect>> call( host port -- stream local ) drop ;
+    irc> [ connect>> ] [ reconnect-attempts>> ] bi do-connect ;
 
 : /JOIN ( channel password -- )
     [ " :" swap 3append ] when* "JOIN " prepend irc-print ;
 
+: try-connect ( -- stream/f )
+    irc> profile>> [ server>> ] [ port>> ] bi /CONNECT ;
+
+: (terminate-irc) ( -- )
+    irc> dup is-running>> [
+        f >>is-running
+        [ stream>> dispose ] keep
+        [ in-messages>> ] [ out-messages>> ] bi 2array
+        [ irc-end swap mailbox-put ] each
+    ] [ drop ] if ;
+
 : (connect-irc) ( -- )
-    irc> {
-        [ profile>> [ server>> ] [ port>> ] bi /CONNECT ]
-        [ (>>stream) ]
-        [ t swap (>>is-running) ]
-        [ in-messages>> [ irc-connected ] dip mailbox-put ]
-    } cleave ;
+    try-connect [
+        [ irc> ] dip >>stream t >>is-running
+        in-messages>> [ irc-connected ] dip mailbox-put
+    ] [ (terminate-irc) ] if* ;
 
 : (do-login) ( -- ) irc> nick>> /LOGIN ;
 
@@ -52,7 +68,7 @@ M: to-all-chats  message-forwards drop chats> ;
 M: to-many-chats message-forwards sender>> participant-chats ;
 
 GENERIC: process-message ( irc-message -- )
-M: object process-message drop ; 
+M: object process-message drop ;
 M: ping   process-message trailing>> /PONG ;
 M: join   process-message [ sender>> ] [ chat> ] bi join-participant ;
 M: part   process-message [ sender>> ] [ chat> ] bi part-participant ;
@@ -92,9 +108,7 @@ M: irc-message handle-outgoing-irc irc-message>string irc-print t ;
 
 : (handle-disconnect) ( -- )
     irc-disconnected irc> in-messages>> mailbox-put
-    irc> reconnect-time>> sleep
-    (connect-irc)
-    (do-login) ;
+    (connect-irc) (do-login) ;
 
 : handle-disconnect ( error -- ? )
     [ irc> exceptions>> push ] when*
@@ -155,12 +169,4 @@ M: irc-channel-chat remove-chat
     [ part new annotate-message irc-send ]
     [ name>> unregister-chat ] bi ;
 
-: (terminate-irc) ( -- )
-    irc> dup is-running>> [
-        f >>is-running
-        [ stream>> dispose ] keep
-        [ in-messages>> ] [ out-messages>> ] bi 2array
-        [ irc-end swap mailbox-put ] each
-    ] [ drop ] if ;
-
-: (speak) ( message irc-chat -- ) swap annotate-message irc-send ;
\ No newline at end of file
+: (speak) ( message irc-chat -- ) swap annotate-message irc-send ;

diff --git a/extra/irc/logbot/log-line/log-line.factor b/extra/irc/logbot/log-line/log-line.factor
index b3af41ad3de34e8e0e53f807b6d83f26ef8900b0..0960a3cedbee57e217dddf2da9a35423a43f5250 100644 (file)
--- a/extra/irc/logbot/log-line/log-line.factor
+++ b/extra/irc/logbot/log-line/log-line.factor
@@ -11,6 +11,12 @@ GENERIC: >log-line ( object -- line )
 
 M: irc-message >log-line line>> ;
 
+M: ctcp >log-line
+    [ "CTCP: " % dup sender>> % " " % text>> % ] "" make ;
+
+M: action >log-line
+    [ "* " % dup sender>> % " " % text>> % ] "" make ;
+
 M: privmsg >log-line
     [ "<" % dup sender>> % "> " % text>> % ] "" make ;
 
@@ -35,3 +41,7 @@ M: participant-mode >log-line
 
 M: nick >log-line
     [ "* " % dup sender>> % " is now known as " % nickname>> % ] "" make ;
+
+M: topic >log-line
+    [ "* " % dup sender>> % " has set the topic for " % dup channel>> %
+      ": \"" % topic>> % "\"" % ] "" make ;

diff --git a/extra/irc/logbot/logbot.factor b/extra/irc/logbot/logbot.factor
index a389304b1476c27ecbb257a9996563af5c1bf2d1..ff8085a9a9c5dc99a1191916056c346c3c0cf8cb 100644 (file)
--- a/extra/irc/logbot/logbot.factor
+++ b/extra/irc/logbot/logbot.factor
@@ -16,7 +16,7 @@ SYMBOL: current-stream
     "irc.freenode.org" 6667 "flogger" f <irc-profile> ;
 
 : add-timestamp ( string timestamp -- string )
-    timestamp>hms "[" prepend "] " append prepend ;
+    timestamp>hms [ "[" % % "] " % % ] "" make ;
 
 : timestamp-path ( timestamp -- path )
     timestamp>ymd ".log" append log-directory prepend-path ;
@@ -27,7 +27,7 @@ SYMBOL: current-stream
     ] [
         current-stream get [ dispose ] when*
         [ day-of-year current-day set ]
-        [ timestamp-path latin1 <file-writer> ] bi
+        [ timestamp-path latin1 <file-appender> ] bi
         current-stream set
     ] if current-stream get ;
 

diff --git a/extra/irc/messages/base/base.factor b/extra/irc/messages/base/base.factor
index d67d226d9bd6ce662dfcc4e6a3c2292c94e6acb5..b785970520738bbe69041e6604271aa49611a00b 100644 (file)
--- a/extra/irc/messages/base/base.factor
+++ b/extra/irc/messages/base/base.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Bruno Deferrari
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs classes.parser classes.tuple
+USING: accessors arrays assocs calendar classes.parser classes.tuple
        combinators fry generic.parser kernel lexer
        mirrors namespaces parser sequences splitting strings words ;
 IN: irc.messages.base
@@ -51,6 +51,7 @@ M: irc-message post-process-irc-message drop ;
 
 GENERIC: fill-irc-message-slots ( irc-message -- )
 M: irc-message fill-irc-message-slots
+    gmt >>timestamp
     {
         [ process-irc-trailing ]
         [ process-irc-prefix ]

diff --git a/extra/irc/messages/messages-tests.factor b/extra/irc/messages/messages-tests.factor
index 539fba54ebd171e8f8a30f5fd47dd60cdca4d068..347bdd00fa4d7a05781305d2e2692259bb1df3f2 100644 (file)
--- a/extra/irc/messages/messages-tests.factor
+++ b/extra/irc/messages/messages-tests.factor
@@ -71,4 +71,7 @@ IN: irc.messages.tests
      { name "nickname" }
      { trailing "Nickname is already in use" } } }
 [ ":ircserver.net 433 * nickname :Nickname is already in use"
-  string>irc-message f >>timestamp ] unit-test
\ No newline at end of file
+  string>irc-message f >>timestamp ] unit-test
+
+{ t } [ ":someuser!n=user@some.where PRIVMSG #factortest :\ 1ACTION jumps!\ 1"
+        string>irc-message action? ] unit-test

diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor
index a6bf02f8a700e60af3153760a77123ad81b99954..2006cc24c313c48ee41282261127dff0fcdb921f 100755 (executable)
--- a/extra/irc/messages/messages.factor
+++ b/extra/irc/messages/messages.factor
@@ -1,7 +1,8 @@
 ! Copyright (C) 2009 Bruno Deferrari
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel fry splitting ascii calendar accessors combinators
-arrays classes.tuple math.order words assocs strings irc.messages.base ;
+arrays classes.tuple math.order words assocs strings irc.messages.base
+combinators.short-circuit math ;
 EXCLUDE: sequences => join ;
 IN: irc.messages
 
@@ -61,8 +62,17 @@ IRC: rpl-names-end       "366" nickname channel : comment ;
 IRC: rpl-nickname-in-use "433" _ name ;
 IRC: rpl-nick-collision  "436" nickname : comment ;
 
+PREDICATE: channel-mode < mode name>> first "#&" member? ;
+PREDICATE: participant-mode < channel-mode parameter>> ;
+PREDICATE: ctcp < privmsg
+    trailing>> { [ length 1 > ] [ first 1 = ] [ peek 1 = ] } 1&& ;
+PREDICATE: action < ctcp trailing>> rest "ACTION" head? ;
+
 M: rpl-names post-process-irc-message ( rpl-names -- )
     [ [ blank? ] trim " " split ] change-nicks drop ;
 
-PREDICATE: channel-mode < mode name>> first "#&" member? ;
-PREDICATE: participant-mode < channel-mode parameter>> ;
+M: ctcp post-process-irc-message ( ctcp -- )
+    [ rest but-last ] change-text drop ;
+
+M: action post-process-irc-message ( action -- )
+    [ 7 tail ] change-text call-next-method ;

diff --git a/extra/irc/messages/parser/parser.factor b/extra/irc/messages/parser/parser.factor
index 1fa07fc7725d7b22ee5461dcce13f0d52f4a5cd2..06a41b0aaab409bfa8fe106656e343dd8b94fea2 100644 (file)
--- a/extra/irc/messages/parser/parser.factor
+++ b/extra/irc/messages/parser/parser.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Bruno Deferrari
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel fry splitting ascii calendar accessors combinators
+USING: kernel fry splitting ascii accessors combinators
        arrays classes.tuple math.order words assocs
        irc.messages.base sequences ;
 IN: irc.messages.parser
@@ -32,4 +32,4 @@ PRIVATE>
     [ >>trailing ]
     tri*
     [ (>>prefix) ] [ fill-irc-message-slots ] [ swap >>line ] tri
-    now >>timestamp dup sender >>sender ;
+    dup sender >>sender ;