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