Merge branch 'master' of git://factorcode.org/git/factor

Conflicts:

	extra/irc/messages/messages.factor

diff --combined extra/irc/client/client.factor
index 7d4c4977bb7f1bc3d4fed15261153dbfe2d80230,2474fd643ac68fb7cdf93465bd746c02692c9074..62e28b2bbf946305ee69923c373ce984e9a55564
--- 1/extra/irc/client/client.factor
--- 2/extra/irc/client/client.factor
+++ b/extra/irc/client/client.factor
@@@ -183,7 -183,7 +183,7 @@@ GENERIC: forward-name ( irc-message -- 
  M: join forward-name ( join -- name ) trailing>> ;
  M: part forward-name ( part -- name ) channel>> ;
  M: kick forward-name ( kick -- name ) channel>> ;
 -M: mode forward-name ( mode -- name ) channel>> ;
 +M: mode forward-name ( mode -- name ) name>> ;
  M: privmsg forward-name ( privmsg -- name )
      dup name>> me? [ irc-message-sender ] [ name>> ] if ;
  
@@@ -334,7 -334,7 +334,7 @@@ DEFER: (connect-irc
  
  : set+run-listener ( name irc-listener -- )
      over irc> listeners>> set-at
-     '[ , listener-loop ] "listener" spawn-irc-loop ;
+     '[ _ listener-loop ] "listener" spawn-irc-loop ;
  
  GENERIC: (add-listener) ( irc-listener -- )
  
@@@ -342,7 -342,7 +342,7 @@@ M: irc-channel-listener (add-listener) 
      [ [ name>> ] [ password>> ] bi /JOIN ]
      [ [ [ drop irc> join-messages>> ]
          [ timeout>> ]
-         [ name>> '[ trailing>> , = ] ]
+         [ name>> '[ trailing>> _ = ] ]
          tri mailbox-get-timeout? trailing>> ] keep set+run-listener
      ] bi ;
  
@@@ -382,10 -382,10 +382,10 @@@ PRIVATE
        spawn-irc ] with-irc-client ;
  
  : add-listener ( irc-listener irc-client -- )
-     swap '[ , (add-listener) ] with-irc-client ;
+     swap '[ _ (add-listener) ] with-irc-client ;
  
  : remove-listener ( irc-listener irc-client -- )
-     swap '[ , (remove-listener) ] with-irc-client ;
+     swap '[ _ (remove-listener) ] with-irc-client ;
  
  : write-message ( message irc-listener -- ) out-messages>> mailbox-put ;
  : read-message ( irc-listener -- message ) in-messages>> mailbox-get ;

diff --combined extra/irc/messages/messages.factor
index db25ba86d8914d3ea1449b6387c3a37b9ab443f9,16066199edef33ea6eb32ff75740d5f1c37d7437..94f80dcf0cadda6b9c2d68f8acf33f2c9772abb5
--- 1/extra/irc/messages/messages.factor
--- 2/extra/irc/messages/messages.factor
+++ b/extra/irc/messages/messages.factor
@@@ -1,7 -1,7 +1,7 @@@
  ! Copyright (C) 2008 Bruno Deferrari
  ! See http://factorcode.org/license.txt for BSD license.
  USING: kernel fry splitting ascii calendar accessors combinators qualified
 -       arrays classes.tuple math.order quotations ;
 +       arrays classes.tuple math.order inverse ;
  RENAME: join sequences => sjoin
  EXCLUDE: sequences => join ;
  IN: irc.messages
@@@ -18,8 -18,8 +18,8 @@@ TUPLE: kick < irc-message channel who 
  TUPLE: roomlist < irc-message channel names ;
  TUPLE: nick-in-use < irc-message asterisk name ;
  TUPLE: notice < irc-message type ;
 -TUPLE: mode < irc-message channel mode ;
 -TUPLE: names-reply < irc-message who = channel ;
 +TUPLE: mode < irc-message name mode parameter ;
 +TUPLE: names-reply < irc-message who channel ;
  TUPLE: unhandled < irc-message ;
  
  : <irc-client-message> ( command parameters trailing -- irc-message )
@@@ -28,58 -28,41 +28,58 @@@
  
  <PRIVATE
  
 -GENERIC: irc-command-string ( irc-message -- string )
 -
 -M: irc-message irc-command-string ( irc-message -- string ) command>> ;
 -M: ping        irc-command-string ( ping -- string )    drop "PING" ;
 -M: join        irc-command-string ( join -- string )    drop "JOIN" ;
 -M: part        irc-command-string ( part -- string )    drop "PART" ;
 -M: quit        irc-command-string ( quit -- string )    drop "QUIT" ;
 -M: nick        irc-command-string ( nick -- string )    drop "NICK" ;
 -M: privmsg     irc-command-string ( privmsg -- string ) drop "PRIVMSG" ;
 -M: notice      irc-command-string ( notice -- string )  drop "NOTICE" ;
 -M: mode        irc-command-string ( mode -- string )    drop "MODE" ;
 -M: kick        irc-command-string ( kick -- string )    drop "KICK" ;
 -
 -GENERIC: irc-command-parameters ( irc-message -- seq )
 -
 -M: irc-message irc-command-parameters ( irc-message -- seq ) parameters>> ;
 -M: ping        irc-command-parameters ( ping -- seq )    drop { } ;
 -M: join        irc-command-parameters ( join -- seq )    drop { } ;
 -M: part        irc-command-parameters ( part -- seq )    channel>> 1array ;
 -M: quit        irc-command-parameters ( quit -- seq )    drop { } ;
 -M: nick        irc-command-parameters ( nick -- seq )    drop { } ;
 -M: privmsg     irc-command-parameters ( privmsg -- seq ) name>> 1array ;
 -M: notice      irc-command-parameters ( norice -- seq )  type>> 1array ;
 -M: kick irc-command-parameters ( kick -- seq )
 +GENERIC: command-string>> ( irc-message -- string )
 +
 +M: irc-message command-string>> ( irc-message -- string ) command>> ;
 +M: ping        command-string>> ( ping -- string )    drop "PING" ;
 +M: join        command-string>> ( join -- string )    drop "JOIN" ;
 +M: part        command-string>> ( part -- string )    drop "PART" ;
 +M: quit        command-string>> ( quit -- string )    drop "QUIT" ;
 +M: nick        command-string>> ( nick -- string )    drop "NICK" ;
 +M: privmsg     command-string>> ( privmsg -- string ) drop "PRIVMSG" ;
 +M: notice      command-string>> ( notice -- string )  drop "NOTICE" ;
 +M: mode        command-string>> ( mode -- string )    drop "MODE" ;
 +M: kick        command-string>> ( kick -- string )    drop "KICK" ;
 +
 +GENERIC: command-parameters>> ( irc-message -- seq )
 +
 +M: irc-message command-parameters>> ( irc-message -- seq ) parameters>> ;
 +M: ping        command-parameters>> ( ping -- seq )    drop { } ;
 +M: join        command-parameters>> ( join -- seq )    drop { } ;
 +M: part        command-parameters>> ( part -- seq )    channel>> 1array ;
 +M: quit        command-parameters>> ( quit -- seq )    drop { } ;
 +M: nick        command-parameters>> ( nick -- seq )    drop { } ;
 +M: privmsg     command-parameters>> ( privmsg -- seq ) name>> 1array ;
 +M: notice      command-parameters>> ( norice -- seq )  type>> 1array ;
 +M: kick command-parameters>> ( kick -- seq )
      [ channel>> ] [ who>> ] bi 2array ;
 -M: mode irc-command-parameters ( mode -- seq )
 +M: mode command-parameters>> ( mode -- seq )
      [ name>> ] [ channel>> ] [ mode>> ] tri 3array ;
  
 +GENERIC: (>>command-parameters) ( params irc-message -- )
 +
 +M: irc-message (>>command-parameters) ( params irc-message -- ) 2drop ;
 +M: logged-in (>>command-parameters) ( params part -- )  [ first ] dip (>>name) ;
 +M: privmsg (>>command-parameters) ( params privmsg -- ) [ first ] dip (>>name) ;
 +M: notice  (>>command-parameters) ( params notice -- )  [ first ] dip (>>type) ;
 +M: part    (>>command-parameters) ( params part -- )
 +    [ first ] dip (>>channel) ;
 +M: kick    (>>command-parameters) ( params kick -- )
 +    [ first2 ] dip [ (>>who) ] [ (>>channel) ] bi ;
 +M: names-reply (>>command-parameters) ( params names-reply -- )
 +    [ [ first ] dip (>>who) ] [ [ third ] dip (>>channel) ] 2bi ;
 +M: mode    (>>command-parameters) ( params mode -- )
 +    { { [ [ 2array ] dip ] [ [ (>>mode) ] [ (>>name) ] bi ] }
 +      { [ [ 3array ] dip ] [ [ (>>parameter) ] [ (>>mode) ] [ (>>name) ] tri ] }
 +    } switch ;
 +
  PRIVATE>
  
  GENERIC: irc-message>client-line ( irc-message -- string )
  
  M: irc-message irc-message>client-line ( irc-message -- string )
 -    [ irc-command-string ]
 -    [ irc-command-parameters " " sjoin ]
 +    [ command-string>> ]
 +    [ command-parameters>> " " sjoin ]
      [ trailing>> [ CHAR: : prefix ] [ "" ] if* ]
      tri 3array " " sjoin ;
  
@@@ -94,7 -77,7 +94,7 @@@ M: irc-message irc-message>server-line 
  ! ======================================
  
  : split-at-first ( seq separators -- before after )
-     dupd '[ , member? ] find
+     dupd '[ _ member? ] find
          [ cut 1 tail ]
          [ swap ]
      if ;
@@@ -113,15 -96,6 +113,15 @@@
  : split-trailing ( string -- string string/f )
      ":" split1 ;
  
 +: copy-message-in ( origin dest -- )
 +    { [ [ parameters>> ] dip [ (>>command-parameters) ] [ (>>parameters) ] 2bi ]
 +      [ [ line>>       ] dip (>>line) ]
 +      [ [ prefix>>     ] dip (>>prefix) ]
 +      [ [ command>>    ] dip (>>command) ]
 +      [ [ trailing>>   ] dip (>>trailing) ]
 +      [ [ timestamp>>  ] dip (>>timestamp) ]
 +    } 2cleave ;
 +
  PRIVATE>
  
  UNION: sender-in-prefix privmsg join part quit kick mode nick ;
@@@ -137,17 -111,20 +137,17 @@@ M: sender-in-prefix irc-message-sender 
  : parse-irc-line ( string -- message )
      string>irc-message
      dup command>> {
 -        { "PING" [ ping ] }
 -        { "NOTICE" [ notice ] }
 -        { "001" [ logged-in ] }
 -        { "433" [ nick-in-use ] }
 -        { "353" [ names-reply ] }
 -        { "JOIN" [ join ] }
 -        { "PART" [ part ] }
 -        { "NICK" [ nick ] }
 +        { "PING"    [ ping ] }
 +        { "NOTICE"  [ notice ] }
 +        { "001"     [ logged-in ] }
 +        { "433"     [ nick-in-use ] }
 +        { "353"     [ names-reply ] }
 +        { "JOIN"    [ join ] }
 +        { "PART"    [ part ] }
 +        { "NICK"    [ nick ] }
          { "PRIVMSG" [ privmsg ] }
 -        { "QUIT" [ quit ] }
 -        { "MODE" [ mode ] }
 -        { "KICK" [ kick ] }
 +        { "QUIT"    [ quit ] }
 +        { "MODE"    [ mode ] }
 +        { "KICK"    [ kick ] }
          [ drop unhandled ]
 -    } case
 -    [ [ tuple-slots ] [ parameters>> ] bi append ] dip
 -    [ all-slots over [ length ] bi@ min head >quotation ] keep
 -    '[ @ _ boa ] call ;
 +    } case new [ copy-message-in ] keep ;