From aec887cc140ea08ebf1ea1701a70869e90b96003 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Fri, 11 Jul 2008 01:16:15 -0300 Subject: [PATCH 1/7] irc.client: Handling of lists of participants in channels, fixes. --- extra/irc/client/client.factor | 45 +++++++++++++++++++++++------- extra/irc/messages/messages.factor | 4 ++- 2 files changed, 38 insertions(+), 11 deletions(-) diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index 472805f5ae..7ab0ea1ab1 100644 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -2,8 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: concurrency.mailboxes kernel io.sockets io.encodings.8-bit calendar accessors destructors namespaces io assocs arrays qualified fry - continuations threads strings classes combinators - irc.messages irc.messages.private ; + continuations threads strings classes combinators splitting hashtables + ascii irc.messages irc.messages.private ; RENAME: join sequences => sjoin EXCLUDE: sequences => join ; IN: irc.client @@ -27,7 +27,7 @@ TUPLE: irc-client profile stream in-messages out-messages join-messages TUPLE: irc-listener in-messages out-messages ; TUPLE: irc-server-listener < irc-listener ; -TUPLE: irc-channel-listener < irc-listener name password timeout ; +TUPLE: irc-channel-listener < irc-listener name password timeout participants ; TUPLE: irc-nick-listener < irc-listener name ; SYMBOL: +server-listener+ @@ -37,7 +37,7 @@ SYMBOL: +server-listener+ irc-server-listener boa ; : ( name -- irc-channel-listener ) - rot f 60 seconds irc-channel-listener boa ; + rot f 60 seconds H{ } clone irc-channel-listener boa ; : ( name -- irc-nick-listener ) rot irc-nick-listener boa ; @@ -74,6 +74,18 @@ UNION: irc-broadcasted-message irc-end irc-disconnected irc-connected ; listener> [ +server-listener+ listener> ] unless* [ in-messages>> mailbox-put ] [ drop ] if* ; +: remove-participant ( nick channel -- ) + listener> [ participants>> delete-at ] [ drop ] if* ; + +: add-participant ( nick mode channel -- ) + listener> [ participants>> set-at ] [ 2drop ] if* ; + +DEFER: me? + +: maybe-forward-join ( join -- ) + [ prefix>> parse-name me? ] keep and + [ irc> join-messages>> mailbox-put ] when* ; + ! ====================================== ! IRC client messages ! ====================================== @@ -153,17 +165,30 @@ M: privmsg handle-incoming-irc ( privmsg -- ) dup irc-message-origin to-listener ; M: join handle-incoming-irc ( join -- ) - [ [ prefix>> parse-name me? ] keep and - [ irc> join-messages>> mailbox-put ] when* ] + [ maybe-forward-join ] [ dup trailing>> to-listener ] - bi ; + [ [ drop f ] [ prefix>> parse-name ] [ trailing>> ] tri add-participant ] + tri ; M: part handle-incoming-irc ( part -- ) - dup channel>> to-listener ; + [ dup channel>> to-listener ] keep + [ prefix>> parse-name ] [ channel>> ] bi remove-participant ; M: kick handle-incoming-irc ( kick -- ) - [ ] [ channel>> ] [ who>> ] tri me? [ dup unregister-listener ] when - to-listener ; + [ [ ] [ channel>> ] bi to-listener ] + [ [ who>> ] [ channel>> ] bi remove-participant ] + [ [ ] [ who>> ] bi me? [ unregister-listener ] [ drop ] if ] + tri ; + +: >nick/mode ( string -- nick mode ) + dup first "+@" member? [ unclip ] [ f ] if ; + +: names-reply>participants ( names-reply -- participants ) + trailing>> [ blank? ] trim " " split + [ >nick/mode 2array ] map >hashtable ; + +M: names-reply handle-incoming-irc ( names-reply -- ) + [ names-reply>participants ] [ channel>> listener> ] bi (>>participants) ; M: irc-broadcasted-message handle-incoming-irc ( irc-broadcasted-message -- ) broadcast-message-to-listeners ; diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index f1beba9b26..fb41997b84 100644 --- a/extra/irc/messages/messages.factor +++ b/extra/irc/messages/messages.factor @@ -7,7 +7,7 @@ IN: irc.messages TUPLE: irc-message line prefix command parameters trailing timestamp ; TUPLE: logged-in < irc-message name ; TUPLE: ping < irc-message ; -TUPLE: join < irc-message channel ; +TUPLE: join < irc-message ; TUPLE: part < irc-message channel ; TUPLE: quit < irc-message ; TUPLE: privmsg < irc-message name ; @@ -16,6 +16,7 @@ TUPLE: roomlist < irc-message channel names ; TUPLE: nick-in-use < irc-message asterisk name ; TUPLE: notice < irc-message type ; TUPLE: mode < irc-message name channel mode ; +TUPLE: names-reply < irc-message who = channel ; TUPLE: unhandled < irc-message ; Date: Fri, 11 Jul 2008 17:11:03 -0400 Subject: [PATCH 2/7] irc.ui now has timestamps --- extra/irc/ui/ui.factor | 28 ++++++++++++++++++---------- 1 file changed, 18 insertions(+), 10 deletions(-) diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor index cc138dad92..54a177f613 100755 --- a/extra/irc/ui/ui.factor +++ b/extra/irc/ui/ui.factor @@ -5,7 +5,8 @@ USING: accessors kernel threads combinators concurrency.mailboxes sequences strings hashtables splitting fry assocs hashtables ui ui.gadgets.panes ui.gadgets.editors ui.gadgets.scrollers ui.commands ui.gadgets.frames ui.gestures ui.gadgets.tabs - io io.styles namespaces irc.client irc.messages ; + io io.styles namespaces irc.client irc.messages calendar + calendar.format ; IN: irc.ui @@ -27,10 +28,20 @@ GENERIC: write-irc ( irc-message -- ) M: privmsg write-irc "<" blue write-color [ prefix>> prefix>nick write ] keep - ">" blue write-color - " " write + "> " blue write-color trailing>> write ; +TUPLE: own-message message nick timestamp ; + +: ( message nick -- own-message ) + now own-message boa ; + +M: own-message write-irc + "<" blue write-color + [ nick>> bold font-style associate format ] keep + "> " blue write-color + message>> write ; + M: join write-irc "* " green write-color prefix>> prefix>nick write @@ -63,15 +74,12 @@ M: irc-message write-irc drop ; ! catch all unimplemented writes, THIS WILL CHANGE : print-irc ( irc-message -- ) - write-irc nl ; + [ timestamp>> timestamp>hms write " " write ] + [ write-irc nl ] bi ; : send-message ( message listener client -- ) - "<" blue write-color - profile>> nickname>> bold font-style associate format - ">" blue write-color - " " write - over write nl - out-messages>> mailbox-put ; + [ nip profile>> nickname>> print-irc ] + [ drop write-message ] 3bi ; : display ( stream listener -- ) '[ , [ [ t ] From b68a982466bb93f9d4af23dd490b5c1e6e1a8a0f Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Fri, 11 Jul 2008 20:23:31 -0300 Subject: [PATCH 3/7] irc.client: Some little changes, and handling of quit messages (removes participant from channels, still needs to forward it) --- extra/irc/client/client.factor | 46 ++++++++++++++++-------------- extra/irc/messages/messages.factor | 18 ++++++++++-- 2 files changed, 40 insertions(+), 24 deletions(-) diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index 7ab0ea1ab1..fb010dbc86 100644 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -37,10 +37,10 @@ SYMBOL: +server-listener+ irc-server-listener boa ; : ( name -- irc-channel-listener ) - rot f 60 seconds H{ } clone irc-channel-listener boa ; + [ ] dip f 60 seconds H{ } clone irc-channel-listener boa ; : ( name -- irc-nick-listener ) - rot irc-nick-listener boa ; + [ ] dip irc-nick-listener boa ; ! ====================================== ! Message objects @@ -52,8 +52,8 @@ SINGLETON: irc-connected ! sent when connection is established UNION: irc-broadcasted-message irc-end irc-disconnected irc-connected ; : terminate-irc ( irc-client -- ) - [ in-messages>> irc-end swap mailbox-put ] - [ f >>is-running drop ] + [ [ irc-end ] dip in-messages>> mailbox-put ] + [ [ f ] dip (>>is-running) ] [ stream>> dispose ] tri ; @@ -77,6 +77,11 @@ UNION: irc-broadcasted-message irc-end irc-disconnected irc-connected ; : remove-participant ( nick channel -- ) listener> [ participants>> delete-at ] [ drop ] if* ; +: remove-participant-from-all ( nick -- ) + irc> listeners>> + [ irc-channel-listener? [ swap remove-participant ] [ 2drop ] if ] with + assoc-each ; + : add-participant ( nick mode channel -- ) listener> [ participants>> set-at ] [ 2drop ] if* ; @@ -90,14 +95,6 @@ DEFER: me? ! IRC client messages ! ====================================== -GENERIC: irc-message>string ( irc-message -- string ) - -M: irc-message irc-message>string ( irc-message -- string ) - [ command>> ] - [ parameters>> " " sjoin ] - [ trailing>> dup [ CHAR: : prefix ] when ] - tri 3array " " sjoin ; - : /NICK ( nick -- ) "NICK " irc-write irc-print ; @@ -111,7 +108,7 @@ M: irc-message irc-message>string ( irc-message -- string ) : /JOIN ( channel password -- ) "JOIN " irc-write - [ " :" swap 3append ] when* irc-print ; + [ [ " :" ] dip 3append ] when* irc-print ; : /PART ( channel text -- ) [ "PART " irc-write irc-write ] dip @@ -175,11 +172,15 @@ M: part handle-incoming-irc ( part -- ) [ prefix>> parse-name ] [ channel>> ] bi remove-participant ; M: kick handle-incoming-irc ( kick -- ) - [ [ ] [ channel>> ] bi to-listener ] + [ dup channel>> to-listener ] [ [ who>> ] [ channel>> ] bi remove-participant ] - [ [ ] [ who>> ] bi me? [ unregister-listener ] [ drop ] if ] + [ dup who>> me? [ unregister-listener ] [ drop ] if ] tri ; +M: quit handle-incoming-irc ( quit -- ) + [ prefix>> parse-name remove-participant-from-all ] keep + call-next-method ; + : >nick/mode ( string -- nick mode ) dup first "+@" member? [ unclip ] [ f ] if ; @@ -213,8 +214,8 @@ M: part handle-outgoing-irc ( privmsg -- ) ! ====================================== : irc-mailbox-get ( mailbox quot -- ) - swap 5 seconds - '[ , , , mailbox-get-timeout swap call ] + [ 5 seconds ] dip + '[ , , , [ mailbox-get-timeout ] dip call ] [ drop ] recover ; inline : handle-reader-message ( irc-message -- ) @@ -224,11 +225,12 @@ DEFER: (connect-irc) : (handle-disconnect) ( -- ) irc> - [ in-messages>> irc-disconnected swap mailbox-put ] + [ [ irc-disconnected ] dip in-messages>> mailbox-put ] [ dup reconnect-time>> sleep (connect-irc) ] [ profile>> nickname>> /LOGIN ] tri ; +! FIXME: do something with the exception, store somewhere to help debugging : handle-disconnect ( error -- ) drop irc> is-running>> [ (handle-disconnect) ] when ; @@ -300,7 +302,7 @@ M: irc-nick-listener (add-listener) ( irc-nick-listener -- ) [ name>> ] keep set+run-listener ; M: irc-server-listener (add-listener) ( irc-server-listener -- ) - +server-listener+ swap set+run-listener ; + [ +server-listener+ ] dip set+run-listener ; GENERIC: (remove-listener) ( irc-listener -- ) @@ -309,7 +311,7 @@ M: irc-nick-listener (remove-listener) ( irc-nick-listener -- ) M: irc-channel-listener (remove-listener) ( irc-channel-listener -- ) [ [ out-messages>> ] [ name>> ] bi - \ part new swap >>channel mailbox-put ] keep + [ \ part new ] dip >>channel mailbox-put ] keep name>> unregister-listener ; M: irc-server-listener (remove-listener) ( irc-server-listener -- ) @@ -319,10 +321,10 @@ M: irc-server-listener (remove-listener) ( irc-server-listener -- ) [ profile>> [ server>> ] [ port>> ] bi /CONNECT ] keep swap >>stream t >>is-running - in-messages>> irc-connected swap mailbox-put ; + in-messages>> [ irc-connected ] dip mailbox-put ; : with-irc-client ( irc-client quot -- ) - >r current-irc-client r> with-variable ; inline + [ current-irc-client ] dip with-variable ; inline PRIVATE> diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index fb41997b84..205630d790 100644 --- a/extra/irc/messages/messages.factor +++ b/extra/irc/messages/messages.factor @@ -1,7 +1,9 @@ ! Copyright (C) 2008 Bruno Deferrari ! See http://factorcode.org/license.txt for BSD license. -USING: kernel fry sequences splitting ascii calendar accessors combinators - classes.tuple math.order ; +USING: kernel fry splitting ascii calendar accessors combinators qualified + arrays classes.tuple math.order ; +RENAME: join sequences => sjoin +EXCLUDE: sequences => join ; IN: irc.messages TUPLE: irc-message line prefix command parameters trailing timestamp ; @@ -19,6 +21,18 @@ TUPLE: mode < irc-message name channel mode ; TUPLE: names-reply < irc-message who = channel ; TUPLE: unhandled < irc-message ; +GENERIC: irc-message>client-line ( irc-message -- string ) + +M: irc-message irc-message>client-line ( irc-message -- string ) + [ command>> ] + [ parameters>> " " sjoin ] + [ trailing>> dup [ CHAR: : prefix ] when ] + tri 3array " " sjoin ; + +GENERIC: irc-message>server-line ( irc-message -- string ) +M: irc-message irc-message>server-line ( irc-message -- string ) + drop "not implemented yet" ; + Date: Sat, 12 Jul 2008 00:04:39 -0300 Subject: [PATCH 4/7] irc.client: Fix, remove-listener now parts from channels correctly --- extra/irc/client/client.factor | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index fb010dbc86..2dbbe8b8f5 100644 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -206,7 +206,7 @@ GENERIC: handle-outgoing-irc ( obj -- ) M: privmsg handle-outgoing-irc ( privmsg -- ) [ name>> ] [ trailing>> ] bi /PRIVMSG ; -M: part handle-outgoing-irc ( privmsg -- ) +M: part handle-outgoing-irc ( part -- ) [ channel>> ] [ trailing>> "" or ] bi /PART ; ! ====================================== @@ -263,6 +263,7 @@ DEFER: (connect-irc) { { [ dup string? ] [ strings>privmsg ] } { [ dup privmsg instance? ] [ swap >>name ] } + [ nip ] } cond ; : listener-loop ( name listener -- ) @@ -310,8 +311,8 @@ M: irc-nick-listener (remove-listener) ( irc-nick-listener -- ) name>> unregister-listener ; M: irc-channel-listener (remove-listener) ( irc-channel-listener -- ) - [ [ out-messages>> ] [ name>> ] bi - [ \ part new ] dip >>channel mailbox-put ] keep + [ [ name>> ] [ out-messages>> ] bi + [ [ part new ] dip >>channel ] dip mailbox-put ] keep name>> unregister-listener ; M: irc-server-listener (remove-listener) ( irc-server-listener -- ) From 3928d3dae0637bbf017ed144c9ecbf447b0a3622 Mon Sep 17 00:00:00 2001 From: William Schlieper Date: Mon, 14 Jul 2008 20:53:08 -0400 Subject: [PATCH 5/7] Added /commands --- .../irc/ui/commandparser/commandparser.factor | 16 ++++ extra/irc/ui/commands/commands.factor | 13 ++++ extra/irc/ui/ui.factor | 73 +++++++++++-------- 3 files changed, 72 insertions(+), 30 deletions(-) create mode 100755 extra/irc/ui/commandparser/commandparser.factor create mode 100755 extra/irc/ui/commands/commands.factor diff --git a/extra/irc/ui/commandparser/commandparser.factor b/extra/irc/ui/commandparser/commandparser.factor new file mode 100755 index 0000000000..7a048c13b1 --- /dev/null +++ b/extra/irc/ui/commandparser/commandparser.factor @@ -0,0 +1,16 @@ +! Copyright (C) 2008 William Schlieper +! See http://factorcode.org/license.txt for BSD license. + +USING: kernel vocabs.loader sequences strings irc.messages ; + +IN: irc.ui.commandparser + +"irc.ui.commands" require + +: command ( string -- command ) + dup empty? [ drop "say" ] when + dup "irc.ui.commands" lookup + [ "quote" "irc.ui.commands" lookup ] unless* ; + +: parse-message ( string -- ) + "/" head? [ " " split1 swap command execute ] when ; diff --git a/extra/irc/ui/commands/commands.factor b/extra/irc/ui/commands/commands.factor new file mode 100755 index 0000000000..9f062f7d11 --- /dev/null +++ b/extra/irc/ui/commands/commands.factor @@ -0,0 +1,13 @@ +! Copyright (C) 2008 William Schlieper +! See http://factorcode.org/license.txt for BSD license. + +USING: kernel irc.client irc.messages irc.ui + +IN: irc.ui.commands + +: say ( string -- ) + [ client get profile>> nickname>> print-irc ] + [ listener get write-message ] bi ; + +: quote ( string -- ) + drop ; ! THIS WILL CHANGE diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor index 54a177f613..dba3f2255c 100755 --- a/extra/irc/ui/ui.factor +++ b/extra/irc/ui/ui.factor @@ -3,13 +3,17 @@ USING: accessors kernel threads combinators concurrency.mailboxes sequences strings hashtables splitting fry assocs hashtables - ui ui.gadgets.panes ui.gadgets.editors ui.gadgets.scrollers - ui.commands ui.gadgets.frames ui.gestures ui.gadgets.tabs - io io.styles namespaces irc.client irc.messages calendar - calendar.format ; + ui ui.gadgets ui.gadgets.panes ui.gadgets.editors + ui.gadgets.scrollers ui.commands ui.gadgets.frames ui.gestures + ui.gadgets.tabs ui.gadgets.grids + io io.styles namespaces irc.client irc.client.private + irc.messages irc.messages.private irc.ui.commandparser + calendar calendar.format ; IN: irc.ui +SYMBOL: listener + SYMBOL: client TUPLE: ui-window client tabs ; @@ -20,14 +24,15 @@ TUPLE: ui-window client tabs ; : green { 0 0.5 0 1 } ; : blue { 0 0 1 1 } ; -: prefix>nick ( prefix -- nick ) - "!" split first ; +: dot-or-parens ( string -- string ) + dup empty? [ drop "." ] + [ "(" prepend ")" append ] if ; GENERIC: write-irc ( irc-message -- ) M: privmsg write-irc "<" blue write-color - [ prefix>> prefix>nick write ] keep + [ prefix>> parse-name write ] keep "> " blue write-color trailing>> write ; @@ -44,22 +49,20 @@ M: own-message write-irc M: join write-irc "* " green write-color - prefix>> prefix>nick write + prefix>> parse-name write " has entered the channel." green write-color ; M: part write-irc "* " red write-color - [ prefix>> prefix>nick write ] keep - " has left the channel(" red write-color - trailing>> write - ")" red write-color ; + [ prefix>> parse-name write ] keep + " has left the channel" red write-color + trailing>> dot-or-parens red write-color ; M: quit write-irc "* " red write-color - [ prefix>> prefix>nick write ] keep - " has left IRC(" red write-color - trailing>> write - ")" red write-color ; + [ prefix>> parse-name write ] keep + " has left IRC" red write-color + trailing>> dot-or-parens red write-color ; M: irc-end write-irc drop "* You have left IRC" red write-color ; @@ -77,9 +80,9 @@ M: irc-message write-irc [ timestamp>> timestamp>hms write " " write ] [ write-irc nl ] bi ; -: send-message ( message listener client -- ) - [ nip profile>> nickname>> print-irc ] - [ drop write-message ] 3bi ; +: send-message ( message -- ) + [ print-irc ] + [ listener get write-message ] bi ; : display ( stream listener -- ) '[ , [ [ t ] @@ -95,32 +98,42 @@ TUPLE: irc-editor < editor outstream listener client ; : ( pane listener client -- editor ) [ irc-editor new-editor swap >>listener swap >>outstream - ] dip client>> >>client ; + ] dip >>client ; : editor-send ( irc-editor -- ) { [ outstream>> ] - [ editor-string ] [ listener>> ] [ client>> ] + [ editor-string ] [ "" swap set-editor-string ] } cleave - '[ , , , send-message ] with-output-stream ; + '[ , listener set , client set , parse-message ] with-output-stream ; irc-editor "general" f { { T{ key-down f f "RET" } editor-send } { T{ key-down f f "ENTER" } editor-send } } define-command-map -: irc-page ( name pane editor tabbed -- ) - [ [ @bottom frame, ! editor - @center frame, ! pane - ] make-frame swap ] dip add-page ; +TUPLE: irc-page < frame listener client ; + +: ( listener client -- irc-page ) + irc-page new-frame + [ g swap client>> >>client swap [ swap (>>listener) ] keep + [ [ g @center grid-add ] keep ] + [ g client>> g @bottom grid-add ] bi + g ] with-gadget ; + +M: irc-page graft* + [ listener>> ] [ client>> ] bi + add-listener ; + +M: irc-page ungraft* + [ listener>> ] [ client>> ] bi + remove-listener ; : join-channel ( name ui-window -- ) [ dup ] dip - [ client>> add-listener ] - [ drop dup ] - [ [ ] keep ] 2tri - tabs>> irc-page ; + [ swap ] keep + tabs>> add-page ; : irc-window ( ui-window -- ) [ tabs>> ] From c02397d3a4eb12bca2e6bdf8b3f6c94decd4412e Mon Sep 17 00:00:00 2001 From: William Schlieper Date: Tue, 15 Jul 2008 02:46:49 -0400 Subject: [PATCH 6/7] Got /commands actually working, irc.ui no longer uses make-gadget et al --- extra/irc/ui/commandparser/commandparser.factor | 9 +++++---- extra/irc/ui/commands/commands.factor | 2 +- extra/irc/ui/ui.factor | 13 ++++++------- 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/extra/irc/ui/commandparser/commandparser.factor b/extra/irc/ui/commandparser/commandparser.factor index 7a048c13b1..2835023c0d 100755 --- a/extra/irc/ui/commandparser/commandparser.factor +++ b/extra/irc/ui/commandparser/commandparser.factor @@ -1,16 +1,17 @@ ! Copyright (C) 2008 William Schlieper ! See http://factorcode.org/license.txt for BSD license. -USING: kernel vocabs.loader sequences strings irc.messages ; +USING: kernel vocabs.loader sequences strings splitting words irc.messages ; IN: irc.ui.commandparser "irc.ui.commands" require -: command ( string -- command ) +: command ( string string -- string command ) dup empty? [ drop "say" ] when dup "irc.ui.commands" lookup - [ "quote" "irc.ui.commands" lookup ] unless* ; + [ nip ] + [ " " append prepend "quote" "irc.ui.commands" lookup ] if* ; : parse-message ( string -- ) - "/" head? [ " " split1 swap command execute ] when ; + "/" ?head [ " " split1 swap command ] [ "say" command ] if execute ; diff --git a/extra/irc/ui/commands/commands.factor b/extra/irc/ui/commands/commands.factor index 9f062f7d11..59f4526d23 100755 --- a/extra/irc/ui/commands/commands.factor +++ b/extra/irc/ui/commands/commands.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 William Schlieper ! See http://factorcode.org/license.txt for BSD license. -USING: kernel irc.client irc.messages irc.ui +USING: accessors kernel irc.client irc.messages irc.ui namespaces ; IN: irc.ui.commands diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor index dba3f2255c..2266c51f41 100755 --- a/extra/irc/ui/ui.factor +++ b/extra/irc/ui/ui.factor @@ -95,10 +95,10 @@ M: irc-message write-irc TUPLE: irc-editor < editor outstream listener client ; -: ( pane listener client -- editor ) - [ irc-editor new-editor +: ( page pane listener -- client editor ) + irc-editor new-editor swap >>listener swap >>outstream - ] dip >>client ; + over client>> >>client ; : editor-send ( irc-editor -- ) { [ outstream>> ] @@ -117,10 +117,9 @@ TUPLE: irc-page < frame listener client ; : ( listener client -- irc-page ) irc-page new-frame - [ g swap client>> >>client swap [ swap (>>listener) ] keep - [ [ g @center grid-add ] keep ] - [ g client>> g @bottom grid-add ] bi - g ] with-gadget ; + swap client>> >>client swap [ >>listener ] keep + [ [ @center grid-add* ] keep ] + [ @bottom grid-add* ] bi ; M: irc-page graft* [ listener>> ] [ client>> ] bi From 36e74f29c0c94db9b04227ab7e1e18cba8260b18 Mon Sep 17 00:00:00 2001 From: William Schlieper Date: Wed, 16 Jul 2008 00:02:04 -0400 Subject: [PATCH 7/7] Added irc.ui.load; now "irc.ui" run works --- extra/irc/ui/ircui-rc | 9 +++++++++ extra/irc/ui/load/load.factor | 16 ++++++++++++++++ extra/irc/ui/ui.factor | 16 ++++++++++------ 3 files changed, 35 insertions(+), 6 deletions(-) create mode 100755 extra/irc/ui/ircui-rc create mode 100755 extra/irc/ui/load/load.factor diff --git a/extra/irc/ui/ircui-rc b/extra/irc/ui/ircui-rc new file mode 100755 index 0000000000..a1533c7b4d --- /dev/null +++ b/extra/irc/ui/ircui-rc @@ -0,0 +1,9 @@ +! Default system ircui-rc file +! Copy into .ircui-rc in your home directory and then change username and such +! To find your home directory, type "home ." into a Factor listener + +USING: irc.client irc.ui ; + +"irc.freenode.org" 8001 "factor-irc" f ! server port nick password +{ "#concatenative" "#terrorisland" } ! all the channels you want to autojoin +server-open diff --git a/extra/irc/ui/load/load.factor b/extra/irc/ui/load/load.factor new file mode 100755 index 0000000000..6655f310e7 --- /dev/null +++ b/extra/irc/ui/load/load.factor @@ -0,0 +1,16 @@ +! Copyright (C) 2008 William Schlieper +! See http://factorcode.org/license.txt for BSD license. + +USING: kernel io.files parser editors sequences ; + +IN: irc.ui.load + +: file-or ( path path -- path ) over exists? ? ; + +: personal-ui-rc ( -- path ) home ".ircui-rc" append-path ; + +: system-ui-rc ( -- path ) "extra/irc/ui/ircui-rc" resource-path ; + +: ircui-rc ( -- path ) personal-ui-rc system-ui-rc file-or ; + +: run-ircui ( -- ) ircui-rc run-file ; diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor index 2266c51f41..12f9d01183 100755 --- a/extra/irc/ui/ui.factor +++ b/extra/irc/ui/ui.factor @@ -6,9 +6,9 @@ USING: accessors kernel threads combinators concurrency.mailboxes ui ui.gadgets ui.gadgets.panes ui.gadgets.editors ui.gadgets.scrollers ui.commands ui.gadgets.frames ui.gestures ui.gadgets.tabs ui.gadgets.grids - io io.styles namespaces irc.client irc.client.private - irc.messages irc.messages.private irc.ui.commandparser - calendar calendar.format ; + io io.styles namespaces calendar calendar.format + irc.client irc.client.private irc.messages irc.messages.private + irc.ui.commandparser irc.ui.load ; IN: irc.ui @@ -145,6 +145,10 @@ M: irc-page ungraft* [ listeners>> +server-listener+ swap at "Server" associate >>tabs ] bi ; -: freenode-connect ( -- ui-window ) - "irc.freenode.org" 8001 "factor-irc" f - ui-connect [ irc-window ] keep ; +: server-open ( server port nick password channels -- ) + [ ui-connect [ irc-window ] keep ] dip + [ over join-channel ] each ; + +: main-run ( -- ) run-ircui ; + +MAIN: main-run