steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
Doug Coleman 2009-04-15 17:36:21 -05:00
parent 2ca8e69348 c304660fa9
commit 55a7f52676
10 changed files with 124 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
extra/irc/client/internals/internals.factor
View File

@ -45,11 +45,11 @@ M: sequence chat-put [ chat-put ] with each ;
! Server message handling
GENERIC: forward-message ( irc-message -- )
M: irc-message forward-message +server-chat+ chat-put ;
M: to-one-chat forward-message dup chat> chat-put ;
M: to-all-chats forward-message chats> chat-put ;
M: to-many-chats forward-message dup sender>> participant-chats chat-put ;
GENERIC: message-forwards ( irc-message -- seq )
M: irc-message message-forwards drop +server-chat+ ;
M: to-one-chat message-forwards chat> ;
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 ;
@ -91,7 +91,7 @@ M: irc-message handle-outgoing-irc irc-message>string irc-print t ;
: handle-reader-message ( irc-message -- ) irc> in-messages>> mailbox-put ;
: (handle-disconnect) ( -- )
irc> in-messages>> irc-disconnected swap mailbox-put
irc-disconnected irc> in-messages>> mailbox-put
irc> reconnect-time>> sleep
(connect-irc)
(do-login) ;
@ -113,8 +113,12 @@ M: f handle-input handle-disconnect ;
! Processing loops
: in-multiplexer-loop ( -- ? )
irc> in-messages>> mailbox-get
[ process-message ] [ forward-message ] [ irc-end? not ] tri ;
irc> in-messages>> mailbox-get {
[ message-forwards ]
[ process-message ]
[ swap chat-put ]
[ irc-end? not ]
} cleave ;
: strings>privmsg ( name string -- privmsg )
" :" prepend append "PRIVMSG " prepend string>irc-message ;

1
extra/irc/logbot/authors.txt Normal file
View File

@ -0,0 +1 @@
Bruno Deferrari

1
extra/irc/logbot/log-line/authors.txt Normal file
View File

@ -0,0 +1 @@
Bruno Deferrari

37
extra/irc/logbot/log-line/log-line.factor Normal file
View File

@ -0,0 +1,37 @@
! Copyright (C) 2009 Bruno Deferrari.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors irc.messages irc.messages.base kernel make ;
EXCLUDE: sequences => join ;
IN: irc.logbot.log-line
: dot-or-parens ( string -- string )
[ "." ] [ " (" prepend ")." append ] if-empty ;
GENERIC: >log-line ( object -- line )
M: irc-message >log-line line>> ;
M: privmsg >log-line
[ "<" % dup sender>> % "> " % text>> % ] "" make ;
M: join >log-line
[ "* " % sender>> % " has joined the channel." % ] "" make ;
M: part >log-line
[ "* " % dup sender>> % " has left the channel" %
comment>> dot-or-parens % ] "" make ;
M: quit >log-line
[ "* " % dup sender>> % " has quit" %
comment>> dot-or-parens % ] "" make ;
M: kick >log-line
[ "* " % dup sender>> % " has kicked " % dup user>> %
" from the channel" % comment>> dot-or-parens % ] "" make ;
M: participant-mode >log-line
[ "* " % dup sender>> % " has set mode " % dup mode>> %
" to " % parameter>> % ] "" make ;
M: nick >log-line
[ "* " % dup sender>> % " is now known as " % nickname>> % ] "" make ;

1
extra/irc/logbot/log-line/summary.txt Normal file
View File

@ -0,0 +1 @@
IRC message formatting for logs

56
extra/irc/logbot/logbot.factor Normal file
View File

@ -0,0 +1,56 @@
! Copyright (C) 2009 Bruno Deferrari.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors calendar calendar.format destructors fry io io.encodings.8-bit
io.files io.pathnames irc.client irc.client.chats irc.messages
irc.messages.base kernel make namespaces sequences threads
irc.logbot.log-line ;
IN: irc.logbot
CONSTANT: bot-channel "#concatenative"
CONSTANT: log-directory "/tmp/logs"
SYMBOL: current-day
SYMBOL: current-stream
: bot-profile ( -- obj )
"irc.freenode.org" 6667 "flogger" f <irc-profile> ;
: add-timestamp ( string timestamp -- string )
timestamp>hms "[" prepend "] " append prepend ;
: timestamp-path ( timestamp -- path )
timestamp>ymd ".log" append log-directory prepend-path ;
: timestamp>stream ( timestamp -- stream )
dup day-of-year current-day get = [
drop
] [
current-stream get [ dispose ] when*
[ day-of-year current-day set ]
[ timestamp-path latin1 <file-writer> ] bi
current-stream set
] if current-stream get ;
: log-message ( string timestamp -- )
[ add-timestamp ] [ timestamp>stream ] bi
[ stream-print ] [ stream-flush ] bi ;
GENERIC: handle-message ( msg -- )
M: object handle-message drop ;
M: irc-message handle-message [ >log-line ] [ timestamp>> ] bi log-message ;
: bot-loop ( chat -- ) dup hear handle-message bot-loop ;
: start-bot ( -- )
bot-profile <irc-client>
[ connect-irc ]
[
[ bot-channel <irc-channel-chat> ] dip
'[ _ [ _ attach-chat ] [ bot-loop ] bi ]
"LogBot" spawn drop
] bi ;
: logbot ( -- ) start-bot ;
MAIN: logbot

1
extra/irc/logbot/summary.txt Normal file
View File

@ -0,0 +1 @@
An IRC logging bot

2
extra/irc/messages/messages.factor
View File

@ -7,7 +7,7 @@ IN: irc.messages
! connection
IRC: pass "PASS" password ;
IRC: nick "NICK" nickname ;
IRC: nick "NICK" : nickname ;
IRC: user "USER" user mode _ : realname ;
IRC: oper "OPER" name password ;
IRC: mode "MODE" name mode parameter ;

21
misc/fuel/fuel-font-lock.el
View File

@ -60,6 +60,7 @@
(declaration keyword "declaration words")
(ebnf-form constant "EBNF: ... ;EBNF form")
(parsing-word keyword "parsing words")
(postpone-body comment "postponed form")
(setter-word function-name "setter words (>>foo)")
(getter-word function-name "getter words (foo>>)")
(stack-effect comment "stack effect specifications")
@ -76,20 +77,19 @@
(defun fuel-font-lock--syntactic-face (state)
(if (nth 3 state) 'factor-font-lock-string
(let ((c (char-after (nth 8 state))))
(cond ((or (char-equal c ?\ )
(char-equal c ?\n)
(char-equal c ?E))
(cond ((memq c '(?\ ?\n ?E ?P))
(save-excursion
(goto-char (nth 8 state))
(beginning-of-line)
(cond ((looking-at-p "USING: ")
(cond ((looking-at "E") 'factor-font-lock-ebnf-form)
((looking-at "P") 'factor-font-lock-postpone-body)
((looking-at-p "USING: ")
'factor-font-lock-vocabulary-name)
((looking-at-p "\\(TUPLE\\|SYMBOLS\\|VARS\\|SINGLETONS\\):")
((looking-at-p
"\\(TUPLE\\|SYMBOLS\\|VARS\\|SINGLETONS\\):")
'factor-font-lock-symbol)
((looking-at-p "C-ENUM:\\( \\|\n\\)")
'factor-font-lock-constant)
((looking-at-p "E")
'factor-font-lock-ebnf-form)
(t 'default))))
((or (char-equal c ?U) (char-equal c ?C))
'factor-font-lock-parsing-word)
@ -102,9 +102,10 @@
(,fuel-syntax--alien-function-regex (1 'factor-font-lock-type-name)
(2 'factor-font-lock-word))
(,fuel-syntax--vocab-ref-regexp 2 'factor-font-lock-vocabulary-name)
(,fuel-syntax--constructor-decl-regex (1 'factor-font-lock-word)
(2 'factor-font-lock-type-name)
(3 'factor-font-lock-invalid-syntax nil t))
(,fuel-syntax--constructor-decl-regex
(1 'factor-font-lock-word)
(2 'factor-font-lock-type-name)
(3 'factor-font-lock-invalid-syntax nil t))
(,fuel-syntax--typedef-regex (1 'factor-font-lock-type-name)
(2 'factor-font-lock-type-name)
(3 'factor-font-lock-invalid-syntax nil t))

4
misc/fuel/fuel-syntax.el
View File

@ -247,12 +247,14 @@
;; Strings and chars
("CHAR: \\(\"\\) [^\\\"]*?\\(\"\\)\\([^\\\"]\\|\\\\.\\)*?\\(\"\\)"
(1 "w") (2 "\"") (4 "\""))
("\\(CHAR:\\|POSTPONE:\\|\\\\\\) \\(.\\)\\( \\|$\\)" (2 "w"))
("\\(CHAR:\\|\\\\\\) \\(.\\)\\( \\|$\\)" (2 "w"))
("\\( \\|^\\)\\(DLL\\|P\\|SBUF\\)\\(\"\\)\\([^\n\r\f\\\"]\\|\\\\.\\)*?\\(\"\\)"
(3 "\"") (5 "\""))
("\\_<\\(\"\\)\\([^\n\r\f\\\"]\\|\\\\.\\)*?\\(\"\\)" (1 "\"") (3 "\""))
("\\_<<\\(\"\\)\\_>" (1 "<b"))
("\\_<\\(\"\\)>\\_>" (1 ">b"))
;; postpone
("\\_<POSTPONE:\\( \\).*\\(\n\\)" (1 "<b") (2 ">b"))
;; Multiline constructs
("\\_<\\(E\\)BNF:\\( \\|\n\\)" (1 "<b"))
("\\_<;EBN\\(F\\)\\_>" (1 ">b"))